3.1 tag creation

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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.
+
+    <one line to give the library's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU 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.
+
+  <signature of Ty Coon>, 1 April 1990
+  Ty Coon, President of Vice
+
+That's all there is to it!

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
+

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.

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.

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.

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.

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.
+

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.

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.

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
+]);

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

wst/tags/3.1/tests/apache_module/mod_wst.lpi

@@ -0,0 +1,359 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="25">
+      <Unit0>
+        <Filename Value="mod_wst.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="mod_wst"/>
+        <CursorPos X="36" Y="47"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="45"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\httpd.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="httpd"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="82"/>
+        <UsageCount Value="45"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="apr"/>
+        <CursorPos X="20" Y="141"/>
+        <TopLine Value="122"/>
+        <UsageCount Value="45"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apriconv\apriconv.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="apriconv"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="21"/>
+        <UsageCount Value="45"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\aprutil\aprutil.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aprutil"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="26"/>
+        <UsageCount Value="45"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\http_config.inc"/>
+        <CursorPos X="11" Y="1123"/>
+        <TopLine Value="1112"/>
+        <UsageCount Value="8"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\httpd.inc"/>
+        <CursorPos X="22" Y="751"/>
+        <TopLine Value="906"/>
+        <UsageCount Value="8"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\http_protocol.inc"/>
+        <CursorPos X="11" Y="385"/>
+        <TopLine Value="385"/>
+        <UsageCount Value="12"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr_lib.inc"/>
+        <CursorPos X="7" Y="44"/>
+        <TopLine Value="33"/>
+        <UsageCount Value="8"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr_time.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="224"/>
+        <UsageCount Value="8"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr_network_io.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="162"/>
+        <UsageCount Value="8"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\systemh.inc"/>
+        <CursorPos X="36" Y="679"/>
+        <TopLine Value="669"/>
+        <UsageCount Value="8"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\win32\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="45"/>
+        <UsageCount Value="8"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="wst_apache_binding.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="wst_apache_binding"/>
+        <CursorPos X="29" Y="246"/>
+        <TopLine Value="297"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="45"/>
+        <Loaded Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\http_log.inc"/>
+        <CursorPos X="11" Y="204"/>
+        <TopLine Value="193"/>
+        <UsageCount Value="8"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\system.inc"/>
+        <CursorPos X="33" Y="1063"/>
+        <TopLine Value="1025"/>
+        <UsageCount Value="8"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr_errno.inc"/>
+        <CursorPos X="23" Y="131"/>
+        <TopLine Value="116"/>
+        <UsageCount Value="8"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\metadata_repository.pas"/>
+        <UnitName Value="metadata_repository"/>
+        <CursorPos X="6" Y="105"/>
+        <TopLine Value="94"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\metadata_wsdl.pas"/>
+        <UnitName Value="metadata_wsdl"/>
+        <CursorPos X="3" Y="589"/>
+        <TopLine Value="576"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="15" Y="616"/>
+        <TopLine Value="605"/>
+        <UsageCount Value="8"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\streams.inc"/>
+        <CursorPos X="5" Y="339"/>
+        <TopLine Value="334"/>
+        <UsageCount Value="8"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\apr_tables.inc"/>
+        <CursorPos X="23" Y="230"/>
+        <TopLine Value="219"/>
+        <UsageCount Value="8"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="..\..\server_binary_formatter.pas"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="3" Y="25"/>
+        <TopLine Value="14"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="22"/>
+        <Loaded Value="True"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="8"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="..\..\server_service_intf.pas"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="14"/>
+        <Loaded Value="True"/>
+      </Unit24>
+    </Units>
+    <JumpHistory Count="29" HistoryIndex="28">
+      <Position1>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="85" Column="46" TopLine="74"/>
+      </Position1>
+      <Position2>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="323" Column="28" TopLine="312"/>
+      </Position2>
+      <Position3>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="324" Column="48" TopLine="313"/>
+      </Position3>
+      <Position4>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="349" Column="32" TopLine="337"/>
+      </Position4>
+      <Position5>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position5>
+      <Position6>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="18" Column="15" TopLine="7"/>
+      </Position6>
+      <Position7>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="25" Column="40" TopLine="14"/>
+      </Position7>
+      <Position8>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="85" Column="33" TopLine="74"/>
+      </Position8>
+      <Position9>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="323" Column="28" TopLine="312"/>
+      </Position9>
+      <Position10>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position10>
+      <Position11>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="18" Column="15" TopLine="7"/>
+      </Position11>
+      <Position12>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="25" Column="40" TopLine="14"/>
+      </Position12>
+      <Position13>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="79" Column="28" TopLine="67"/>
+      </Position13>
+      <Position14>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="265" Column="11" TopLine="246"/>
+      </Position14>
+      <Position15>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position15>
+      <Position16>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="49" Column="32" TopLine="30"/>
+      </Position16>
+      <Position17>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="79" Column="28" TopLine="60"/>
+      </Position17>
+      <Position18>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="269" Column="1" TopLine="264"/>
+      </Position18>
+      <Position19>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position19>
+      <Position20>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="52" Column="11" TopLine="30"/>
+      </Position20>
+      <Position21>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="58" Column="74" TopLine="52"/>
+      </Position21>
+      <Position22>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="19" Column="20" TopLine="1"/>
+      </Position22>
+      <Position23>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="43" Column="1" TopLine="41"/>
+      </Position23>
+      <Position24>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="309" Column="1" TopLine="271"/>
+      </Position24>
+      <Position25>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="296" Column="38" TopLine="277"/>
+      </Position25>
+      <Position26>
+        <Filename Value="mod_wst.lpr"/>
+        <Caret Line="16" Column="1" TopLine="3"/>
+      </Position26>
+      <Position27>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="238" Column="18" TopLine="223"/>
+      </Position27>
+      <Position28>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="245" Column="20" TopLine="240"/>
+      </Position28>
+      <Position29>
+        <Filename Value="wst_apache_binding.pas"/>
+        <Caret Line="1" Column="19" TopLine="1"/>
+      </Position29>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="mod_wst.so"/>
+    </Target>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apriconv\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\aprutil\;..\..\;..\..\tests\calculator\;..\..\tests\calculator\srv\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apr\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\apriconv\;D:\lazarusClean\others_package\apache\httpd-0.2\httpd\httpd_2_0\aprutil\;..\..\;..\..\tests\calculator\;..\..\tests\calculator\srv\"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleMacros Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-WR"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

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.

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 := '<html>' +
+              '<head>'+
+                '<title>'+
+                  'The Web Service Toolkit generated Metadata table'+
+                '</title>'+
+                '<body>' +
+                  '<p BGCOLOR="#DDEEFF"><FONT FACE="Arial" COLOR="#0000A0" SIZE="+2">The following repositories has available. Click on the link to view the corresponding WSDL.</FONT></p>'+
+                  '<table width="100%">';
+
+  for i := 0 to Pred(r.GetCount()) do
+    Result := Result + '<tr>' +
+                        '<td>' +
+                            Format('<a href="%s">',[sSEPARATOR+sWST_ROOT+sSEPARATOR+sSERVICES_PREFIXE+sSEPARATOR+sWSDL+sSEPARATOR+r.GetRepositoryName(i)])+
+                            r.GetRepositoryName(i) +
+                            '</a>'+
+                        '</td>' +
+                      '</tr>';
+
+  Result := Result +
+                    '</tr>'+
+                  '</table>'+
+                '</body>'+
+              '</head>'+
+            '</html>';
+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('<HTML><HEAD> <TITLE>Error</TITLE></HEAD>' + LineEnding, r);
+      ap_rputs('<BODY></BODY></HTML>',r);
+      ap_rprintf(r, '<BODY><H1>"%s"</H1></BODY></HTML>' + 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.

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.

wst/tags/3.1/tests/calculator/client/calc_client.lpi

@@ -0,0 +1,278 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="20">
+      <Unit0>
+        <Filename Value="calc_client.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calc_client"/>
+        <CursorPos X="22" Y="49"/>
+        <TopLine Value="37"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="68"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="calculator_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_proxy"/>
+        <CursorPos X="44" Y="155"/>
+        <TopLine Value="4"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="68"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\..\..\base_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="87" Y="348"/>
+        <TopLine Value="348"/>
+        <UsageCount Value="44"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="121"/>
+        <UsageCount Value="30"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="1" Y="17"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="24"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\..\..\binary_formatter.pas"/>
+        <UnitName Value="binary_formatter"/>
+        <CursorPos X="1" Y="40"/>
+        <TopLine Value="31"/>
+        <UsageCount Value="34"/>
+        <Bookmarks Count="1">
+          <Item0 X="26" Y="94" ID="3"/>
+        </Bookmarks>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\..\..\ics_tcp_protocol.pas"/>
+        <UnitName Value="ics_tcp_protocol"/>
+        <CursorPos X="55" Y="127"/>
+        <TopLine Value="111"/>
+        <UsageCount Value="25"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\..\..\ics_http_protocol.pas"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="23" Y="1"/>
+        <TopLine Value="2"/>
+        <UsageCount Value="13"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="39" Y="730"/>
+        <TopLine Value="729"/>
+        <UsageCount Value="24"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\calculator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="53" Y="67"/>
+        <TopLine Value="33"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="68"/>
+        <Loaded Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\system.pp"/>
+        <UnitName Value="System"/>
+        <CursorPos X="4" Y="506"/>
+        <TopLine Value="496"/>
+        <UsageCount Value="9"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\xml\xmlread.pp"/>
+        <UnitName Value="XMLRead"/>
+        <CursorPos X="26" Y="245"/>
+        <TopLine Value="240"/>
+        <UsageCount Value="6"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocket.pas"/>
+        <UnitName Value="WSocket"/>
+        <CursorPos X="24" Y="844"/>
+        <TopLine Value="834"/>
+        <UsageCount Value="6"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="21" Y="885"/>
+        <TopLine Value="895"/>
+        <UsageCount Value="28"/>
+        <Bookmarks Count="2">
+          <Item0 X="24" Y="969" ID="1"/>
+          <Item1 X="19" Y="802" ID="2"/>
+        </Bookmarks>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="55" Y="791"/>
+        <TopLine Value="777"/>
+        <UsageCount Value="9"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="31" Y="36"/>
+        <TopLine Value="17"/>
+        <UsageCount Value="13"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="3" Y="30"/>
+        <TopLine Value="20"/>
+        <UsageCount Value="21"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\objpas.pp"/>
+        <UnitName Value="objpas"/>
+        <CursorPos X="5" Y="108"/>
+        <TopLine Value="91"/>
+        <UsageCount Value="9"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\systemh.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="83"/>
+        <UsageCount Value="9"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\..\metadata_repository.pas"/>
+        <UnitName Value="metadata_repository"/>
+        <CursorPos X="6" Y="105"/>
+        <TopLine Value="94"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit19>
+    </Units>
+    <JumpHistory Count="5" HistoryIndex="4">
+      <Position1>
+        <Filename Value="calc_client.pas"/>
+        <Caret Line="61" Column="49" TopLine="45"/>
+      </Position1>
+      <Position2>
+        <Filename Value="calc_client.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position2>
+      <Position3>
+        <Filename Value="calc_client.pas"/>
+        <Caret Line="3" Column="45" TopLine="1"/>
+      </Position3>
+      <Position4>
+        <Filename Value="..\..\..\metadata_repository.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position4>
+      <Position5>
+        <Filename Value="calculator_proxy.pas"/>
+        <Caret Line="93" Column="49" TopLine="77"/>
+      </Position5>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\LazarusClean\others_package\ics\latest_distr\Delphi\Vc32\;..\..\..\;..\..\..\tests\calculator\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="..\..\..\;D:\LazarusClean\others_package\ics\latest_distr\Delphi\Vc32\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="9">
+      <Item1>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\..\..\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+      <Item8>
+        <Source Value="..\..\..\..\base_service_intf.pas"/>
+        <Line Value="505"/>
+      </Item8>
+      <Item9>
+        <Source Value="..\..\..\..\base_binary_formatter.pas"/>
+        <Line Value="928"/>
+      </Item9>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.

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
+]);

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.

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
+]);

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.

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

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
+]);

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.
+

wst/tags/3.1/tests/calculator/gui_client/test_calc.lpi

@@ -0,0 +1,369 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="35">
+      <Unit0>
+        <Filename Value="test_calc.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_calc"/>
+        <CursorPos X="66" Y="10"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="80"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main_unit.pas"/>
+        <ComponentName Value="fmain"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="main_unit.lrs"/>
+        <UnitName Value="main_unit"/>
+        <CursorPos X="28" Y="58"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="80"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\calculator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="30" Y="16"/>
+        <TopLine Value="8"/>
+        <EditorIndex Value="8"/>
+        <UsageCount Value="80"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="calculator_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_proxy"/>
+        <CursorPos X="28" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="9"/>
+        <UsageCount Value="80"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="1" Y="147"/>
+        <TopLine Value="136"/>
+        <UsageCount Value="12"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\..\..\ics_tcp_protocol.pas"/>
+        <UnitName Value="ics_tcp_protocol"/>
+        <CursorPos X="1" Y="181"/>
+        <TopLine Value="167"/>
+        <UsageCount Value="7"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="12" Y="356"/>
+        <TopLine Value="345"/>
+        <UsageCount Value="12"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocket.pas"/>
+        <UnitName Value="WSocket"/>
+        <CursorPos X="26" Y="1729"/>
+        <TopLine Value="1728"/>
+        <UsageCount Value="9"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="1" Y="76"/>
+        <TopLine Value="65"/>
+        <UsageCount Value="13"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="1" Y="908"/>
+        <TopLine Value="894"/>
+        <UsageCount Value="13"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\..\..\imp_utils.pas"/>
+        <UnitName Value="imp_utils"/>
+        <CursorPos X="1" Y="55"/>
+        <TopLine Value="41"/>
+        <UsageCount Value="10"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="32" Y="393"/>
+        <TopLine Value="386"/>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\lazarusClean\lcl\include\control.inc"/>
+        <CursorPos X="1" Y="2261"/>
+        <TopLine Value="2249"/>
+        <UsageCount Value="7"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\..\..\ics_http_protocol.pas"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="65" Y="118"/>
+        <TopLine Value="109"/>
+        <UsageCount Value="10"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\HttpProt.pas"/>
+        <UnitName Value="HttpProt"/>
+        <CursorPos X="5" Y="840"/>
+        <TopLine Value="828"/>
+        <UsageCount Value="9"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="27" Y="360"/>
+        <TopLine Value="351"/>
+        <UsageCount Value="10"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="18" Y="151"/>
+        <TopLine Value="135"/>
+        <EditorIndex Value="7"/>
+        <UsageCount Value="32"/>
+        <Loaded Value="True"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="42" Y="171"/>
+        <TopLine Value="157"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="32"/>
+        <Loaded Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="58" Y="47"/>
+        <TopLine Value="31"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="32"/>
+        <Loaded Value="True"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\..\ics_http_protocol.pas"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="35" Y="19"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="13"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="..\..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="454"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="31"/>
+        <Loaded Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="..\..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="3" Y="235"/>
+        <TopLine Value="229"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="31"/>
+        <Loaded Value="True"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="3" Y="1394"/>
+        <TopLine Value="1389"/>
+        <UsageCount Value="10"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="32" Y="604"/>
+        <TopLine Value="593"/>
+        <UsageCount Value="11"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\stringl.inc"/>
+        <CursorPos X="44" Y="472"/>
+        <TopLine Value="82"/>
+        <UsageCount Value="11"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="..\..\..\imp_utils.pas"/>
+        <UnitName Value="imp_utils"/>
+        <CursorPos X="36" Y="104"/>
+        <TopLine Value="88"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="15"/>
+        <Loaded Value="True"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\classes.pp"/>
+        <UnitName Value="Classes"/>
+        <CursorPos X="6" Y="28"/>
+        <TopLine Value="16"/>
+        <UsageCount Value="10"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\rtlconsts.pp"/>
+        <UnitName Value="RtlConsts"/>
+        <CursorPos X="10" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="10"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\rtlconst.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="55"/>
+        <UsageCount Value="10"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="9" Y="56"/>
+        <TopLine Value="49"/>
+        <UsageCount Value="10"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysconst.pp"/>
+        <UnitName Value="sysconst"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="10"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\types.pp"/>
+        <UnitName Value="types"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="10"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="..\..\..\synapse_http_protocol.pas"/>
+        <UnitName Value="synapse_http_protocol"/>
+        <CursorPos X="34" Y="148"/>
+        <TopLine Value="131"/>
+        <UsageCount Value="10"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\streams.inc"/>
+        <CursorPos X="7" Y="159"/>
+        <TopLine Value="158"/>
+        <UsageCount Value="10"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="..\..\..\binary_formatter.pas"/>
+        <UnitName Value="binary_formatter"/>
+        <CursorPos X="44" Y="132"/>
+        <TopLine Value="120"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit34>
+    </Units>
+    <JumpHistory Count="2" HistoryIndex="1">
+      <Position1>
+        <Filename Value="main_unit.pas"/>
+        <Caret Line="64" Column="31" TopLine="51"/>
+      </Position1>
+      <Position2>
+        <Filename Value="main_unit.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position2>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\;..\;..\..\..\;D:\Lazarus\others_package\synapse\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="6">
+      <Item1>
+        <Source Value="..\..\..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\..\..\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\..\..\basic_binder.pas"/>
+        <Line Value="62"/>
+      </Item5>
+      <Item6>
+        <Source Value="main_unit.pas"/>
+        <Line Value="54"/>
+      </Item6>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

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
+]);

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.

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.

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.

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
+]);

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 = '<your AppId>';
+  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.

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.

wst/tags/3.1/tests/ebay/test_ebay.lpi

@@ -0,0 +1,386 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="indylaz"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="22">
+      <Unit0>
+        <Filename Value="test_ebay.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_ebay"/>
+        <CursorPos X="34" Y="63"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="43"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="ebay.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ebay"/>
+        <CursorPos X="18" Y="103"/>
+        <TopLine Value="156"/>
+        <UsageCount Value="43"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="1" Y="151"/>
+        <TopLine Value="140"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="43"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="25" Y="244"/>
+        <TopLine Value="236"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="43"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="20" Y="30"/>
+        <TopLine Value="11"/>
+        <UsageCount Value="43"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="1" Y="619"/>
+        <TopLine Value="608"/>
+        <UsageCount Value="43"/>
+        <Bookmarks Count="1">
+          <Item0 X="11" Y="610" ID="1"/>
+        </Bookmarks>
+      </Unit5>
+      <Unit6>
+        <Filename Value="ebay_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ebay_proxy"/>
+        <CursorPos X="1" Y="34"/>
+        <TopLine Value="23"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="43"/>
+        <Loaded Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="33" Y="161"/>
+        <TopLine Value="143"/>
+        <UsageCount Value="19"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdSSLOpenSSL.pas"/>
+        <UnitName Value="IdSSLOpenSSL"/>
+        <CursorPos X="14" Y="267"/>
+        <TopLine Value="250"/>
+        <UsageCount Value="17"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\indy_http_protocol.pas"/>
+        <UnitName Value="indy_http_protocol"/>
+        <CursorPos X="1" Y="38"/>
+        <TopLine Value="38"/>
+        <UsageCount Value="20"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTP.pas"/>
+        <UnitName Value="IdHTTP"/>
+        <CursorPos X="9" Y="342"/>
+        <TopLine Value="328"/>
+        <UsageCount Value="12"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdSSL.pas"/>
+        <UnitName Value="IdSSL"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="14"/>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Core\IdTCPClient.pas"/>
+        <UnitName Value="IdTCPClient"/>
+        <CursorPos X="3" Y="144"/>
+        <TopLine Value="165"/>
+        <UsageCount Value="12"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="synapse_http_protocol"/>
+        <CursorPos X="1" Y="155"/>
+        <TopLine Value="132"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="24"/>
+        <Loaded Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\others_package\synapse\httpsend.pas"/>
+        <UnitName Value="httpsend"/>
+        <CursorPos X="30" Y="143"/>
+        <TopLine Value="132"/>
+        <UsageCount Value="12"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\lazarusClean\others_package\synapse\blcksock.pas"/>
+        <UnitName Value="blcksock"/>
+        <CursorPos X="1" Y="3571"/>
+        <TopLine Value="3560"/>
+        <UsageCount Value="12"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="D:\lazarusClean\others_package\synapse\ssl_openssl.pas"/>
+        <UnitName Value="ssl_openssl"/>
+        <CursorPos X="1" Y="506"/>
+        <TopLine Value="495"/>
+        <UsageCount Value="10"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="D:\lazarusClean\others_package\synapse\ssl_openssl_lib.pas"/>
+        <UnitName Value="ssl_openssl_lib"/>
+        <CursorPos X="1" Y="1233"/>
+        <TopLine Value="1222"/>
+        <UsageCount Value="10"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="14" Y="604"/>
+        <TopLine Value="593"/>
+        <UsageCount Value="10"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\streams.inc"/>
+        <CursorPos X="7" Y="180"/>
+        <TopLine Value="158"/>
+        <UsageCount Value="10"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <UnitName Value="httpsend"/>
+        <CursorPos X="1" Y="566"/>
+        <TopLine Value="555"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\Lazarus\others_package\synapse\blcksock.pas"/>
+        <UnitName Value="blcksock"/>
+        <CursorPos X="1" Y="1901"/>
+        <TopLine Value="1890"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit21>
+    </Units>
+    <JumpHistory Count="26" HistoryIndex="25">
+      <Position1>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="531" Column="1" TopLine="520"/>
+      </Position1>
+      <Position2>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="534" Column="1" TopLine="523"/>
+      </Position2>
+      <Position3>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="537" Column="1" TopLine="526"/>
+      </Position3>
+      <Position4>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="538" Column="11" TopLine="527"/>
+      </Position4>
+      <Position5>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="541" Column="32" TopLine="530"/>
+      </Position5>
+      <Position6>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="543" Column="1" TopLine="532"/>
+      </Position6>
+      <Position7>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="544" Column="1" TopLine="533"/>
+      </Position7>
+      <Position8>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="558" Column="1" TopLine="547"/>
+      </Position8>
+      <Position9>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="559" Column="1" TopLine="548"/>
+      </Position9>
+      <Position10>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="561" Column="1" TopLine="550"/>
+      </Position10>
+      <Position11>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="562" Column="1" TopLine="551"/>
+      </Position11>
+      <Position12>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="563" Column="1" TopLine="552"/>
+      </Position12>
+      <Position13>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="565" Column="1" TopLine="554"/>
+      </Position13>
+      <Position14>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="566" Column="1" TopLine="555"/>
+      </Position14>
+      <Position15>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="572" Column="1" TopLine="561"/>
+      </Position15>
+      <Position16>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="574" Column="1" TopLine="563"/>
+      </Position16>
+      <Position17>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="580" Column="1" TopLine="569"/>
+      </Position17>
+      <Position18>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="582" Column="1" TopLine="571"/>
+      </Position18>
+      <Position19>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="561" Column="1" TopLine="550"/>
+      </Position19>
+      <Position20>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="562" Column="1" TopLine="551"/>
+      </Position20>
+      <Position21>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="563" Column="1" TopLine="552"/>
+      </Position21>
+      <Position22>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="565" Column="1" TopLine="554"/>
+      </Position22>
+      <Position23>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <Caret Line="566" Column="1" TopLine="555"/>
+      </Position23>
+      <Position24>
+        <Filename Value="test_ebay.lpr"/>
+        <Caret Line="75" Column="64" TopLine="58"/>
+      </Position24>
+      <Position25>
+        <Filename Value="test_ebay.lpr"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position25>
+      <Position26>
+        <Filename Value="test_ebay.lpr"/>
+        <Caret Line="63" Column="34" TopLine="52"/>
+      </Position26>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\..\;D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\;D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\;D:\lazarus\others_package\synapse\"/>
+      <UnitOutputDirectory Value="obj"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="12">
+      <Item1>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+      <Item8>
+        <Source Value="test_ebay.lpr"/>
+        <Line Value="67"/>
+      </Item8>
+      <Item9>
+        <Source Value="..\..\synapse_http_protocol.pas"/>
+        <Line Value="160"/>
+      </Item9>
+      <Item10>
+        <Source Value="D:\lazarusClean\others_package\synapse\ssl_openssl.pas"/>
+        <Line Value="813"/>
+      </Item10>
+      <Item11>
+        <Source Value="..\..\synapse_http_protocol.pas"/>
+        <Line Value="156"/>
+      </Item11>
+      <Item12>
+        <Source Value="..\..\synapse_http_protocol.pas"/>
+        <Line Value="150"/>
+      </Item12>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

wst/tags/3.1/tests/ebay/test_ebay_gui.lpi

@@ -0,0 +1,304 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="3"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="23">
+      <Unit0>
+        <Filename Value="test_ebay_gui.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_ebay_gui"/>
+        <CursorPos X="1" Y="17"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="63"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="umain.lrs"/>
+        <UnitName Value="umain"/>
+        <CursorPos X="39" Y="144"/>
+        <TopLine Value="137"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="63"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="synapse_http_protocol"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="157"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="63"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="30"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="23" Y="333"/>
+        <TopLine Value="320"/>
+        <UsageCount Value="31"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="60" Y="159"/>
+        <TopLine Value="149"/>
+        <UsageCount Value="24"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\imp_utils.pas"/>
+        <UnitName Value="imp_utils"/>
+        <CursorPos X="3" Y="119"/>
+        <TopLine Value="109"/>
+        <UsageCount Value="17"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="33" Y="86"/>
+        <TopLine Value="76"/>
+        <UsageCount Value="26"/>
+        <Bookmarks Count="2">
+          <Item0 X="14" Y="670" ID="1"/>
+          <Item1 X="1" Y="437" ID="2"/>
+        </Bookmarks>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\lazarusClean\others_package\synapse\httpsend.pas"/>
+        <UnitName Value="httpsend"/>
+        <CursorPos X="40" Y="123"/>
+        <TopLine Value="122"/>
+        <UsageCount Value="10"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="ebay.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ebay"/>
+        <CursorPos X="13" Y="536"/>
+        <TopLine Value="525"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="47"/>
+        <Loaded Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\metadata_service.pas"/>
+        <UnitName Value="metadata_service"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="43"/>
+        <UsageCount Value="8"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\metadata_repository.pas"/>
+        <UnitName Value="metadata_repository"/>
+        <CursorPos X="46" Y="84"/>
+        <TopLine Value="84"/>
+        <UsageCount Value="17"/>
+        <Bookmarks Count="1">
+          <Item0 X="1" Y="91" ID="3"/>
+        </Bookmarks>
+      </Unit11>
+      <Unit12>
+        <Filename Value="ebay_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ebay_proxy"/>
+        <CursorPos X="26" Y="96"/>
+        <TopLine Value="77"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="47"/>
+        <Loaded Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\heaph.inc"/>
+        <CursorPos X="10" Y="94"/>
+        <TopLine Value="82"/>
+        <UsageCount Value="8"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\heap.inc"/>
+        <CursorPos X="3" Y="342"/>
+        <TopLine Value="346"/>
+        <UsageCount Value="8"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="94"/>
+        <UsageCount Value="9"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="ebay.lrs"/>
+        <CursorPos X="20" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="9"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="D:\lazarusClean\lcl\lresources.pp"/>
+        <UnitName Value="LResources"/>
+        <CursorPos X="3" Y="930"/>
+        <TopLine Value="907"/>
+        <UsageCount Value="9"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpash.inc"/>
+        <CursorPos X="20" Y="169"/>
+        <TopLine Value="157"/>
+        <UsageCount Value="10"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpas.inc"/>
+        <CursorPos X="28" Y="446"/>
+        <TopLine Value="428"/>
+        <UsageCount Value="10"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="23" Y="520"/>
+        <TopLine Value="517"/>
+        <UsageCount Value="10"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="15" Y="204"/>
+        <TopLine Value="192"/>
+        <UsageCount Value="10"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="3" Y="417"/>
+        <TopLine Value="412"/>
+        <UsageCount Value="10"/>
+      </Unit22>
+    </Units>
+    <JumpHistory Count="5" HistoryIndex="4">
+      <Position1>
+        <Filename Value="umain.pas"/>
+        <Caret Line="31" Column="25" TopLine="26"/>
+      </Position1>
+      <Position2>
+        <Filename Value="umain.pas"/>
+        <Caret Line="149" Column="36" TopLine="138"/>
+      </Position2>
+      <Position3>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="24" TopLine="33"/>
+      </Position3>
+      <Position4>
+        <Filename Value="ebay_proxy.pas"/>
+        <Caret Line="96" Column="26" TopLine="77"/>
+      </Position4>
+      <Position5>
+        <Filename Value="ebay.pas"/>
+        <Caret Line="524" Column="5" TopLine="515"/>
+      </Position5>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\lazarus\others_package\synapse\;..\..\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value=""/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="10">
+      <Item1>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+      <Item8>
+        <Source Value="test_ebay.lpr"/>
+        <Line Value="67"/>
+      </Item8>
+      <Item9>
+        <Source Value="D:\lazarusClean\others_package\synapse\ssl_openssl.pas"/>
+        <Line Value="813"/>
+      </Item9>
+      <Item10>
+        <Source Value="umain.pas"/>
+        <Line Value="92"/>
+      </Item10>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

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

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
+]);

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.
+

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
+]);

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.

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.

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.

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;

wst/tags/3.1/tests/google_api/test_google_api.lpi

@@ -0,0 +1,391 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="indylaz"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="41">
+      <Unit0>
+        <Filename Value="test_google_api.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_google_api"/>
+        <CursorPos X="22" Y="15"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="googlewebapi.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="googlewebapi"/>
+        <CursorPos X="47" Y="85"/>
+        <TopLine Value="73"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="googlewebapiimpunit.pas"/>
+        <UnitName Value="googlewebapiimpunit"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="98"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="home\inoussa\Projets\Laz\http_call_handler.pas"/>
+        <UnitName Value="http_call_handler"/>
+        <CursorPos X="22" Y="21"/>
+        <TopLine Value="75"/>
+        <UsageCount Value="18"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="home\inoussa\Projets\Laz\formaterintf.pas"/>
+        <UnitName Value="formaterintf"/>
+        <CursorPos X="69" Y="56"/>
+        <TopLine Value="44"/>
+        <UsageCount Value="18"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="home\inoussa\Projets\Laz\baseobject.pas"/>
+        <UnitName Value="baseobject"/>
+        <CursorPos X="37" Y="20"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="8"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="home\inoussa\Projets\Laz\xml_formater.pas"/>
+        <UnitName Value="xml_formater"/>
+        <CursorPos X="53" Y="733"/>
+        <TopLine Value="719"/>
+        <UsageCount Value="8"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="home\inoussa\Projets\Laz\ws_helper\parserutils.pas"/>
+        <UsageCount Value="8"/>
+        <SyntaxHighlighter Value="Text"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="home\inoussa\Projets\Laz\type_registry.pas"/>
+        <UnitName Value="type_registry"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="45"/>
+        <UsageCount Value="8"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="home\inoussa\Projets\Laz\basestubimp.pas"/>
+        <UnitName Value="basestubimp"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="107"/>
+        <UsageCount Value="8"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="usr\share\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="11" Y="220"/>
+        <TopLine Value="201"/>
+        <UsageCount Value="9"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="1" Y="579"/>
+        <TopLine Value="567"/>
+        <UsageCount Value="1"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="home\inoussa\Projets\Laz\v0.2\soap_imp.pas"/>
+        <UnitName Value="soap_imp"/>
+        <CursorPos X="1" Y="701"/>
+        <TopLine Value="689"/>
+        <UsageCount Value="1"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <UnitName Value="imp_utils"/>
+        <CursorPos X="1" Y="83"/>
+        <TopLine Value="71"/>
+        <UsageCount Value="1"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <UnitName Value="indy_http_protocol"/>
+        <CursorPos X="1" Y="50"/>
+        <TopLine Value="38"/>
+        <UsageCount Value="1"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="home\inoussa\Progs\indy-10.2.0.1\fpc\Protocols\IdHTTP.pas"/>
+        <UnitName Value="IdHTTP"/>
+        <CursorPos X="45" Y="1517"/>
+        <TopLine Value="1509"/>
+        <UsageCount Value="10"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\indy_http_protocol.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="indy_http_protocol"/>
+        <CursorPos X="45" Y="166"/>
+        <TopLine Value="156"/>
+        <UsageCount Value="63"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="3" Y="17"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="125"/>
+        <Loaded Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\HttpProt.pas"/>
+        <UnitName Value="HttpProt"/>
+        <CursorPos X="65" Y="468"/>
+        <TopLine Value="454"/>
+        <UsageCount Value="9"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\soap_imp.pas"/>
+        <UnitName Value="soap_imp"/>
+        <CursorPos X="46" Y="42"/>
+        <TopLine Value="27"/>
+        <UsageCount Value="30"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="3" Y="225"/>
+        <TopLine Value="212"/>
+        <UsageCount Value="55"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="14" Y="278"/>
+        <TopLine Value="261"/>
+        <UsageCount Value="6"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="3" Y="745"/>
+        <TopLine Value="743"/>
+        <UsageCount Value="3"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="20" Y="40"/>
+        <TopLine Value="87"/>
+        <UsageCount Value="3"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\win32\system.pp"/>
+        <UnitName Value="System"/>
+        <CursorPos X="6" Y="16"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="2"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="xml_serializer.pas"/>
+        <UnitName Value="xml_serializer"/>
+        <CursorPos X="1" Y="80"/>
+        <TopLine Value="36"/>
+        <UsageCount Value="31"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\systemh.inc"/>
+        <CursorPos X="3" Y="215"/>
+        <TopLine Value="201"/>
+        <UsageCount Value="5"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="3" Y="248"/>
+        <TopLine Value="227"/>
+        <UsageCount Value="47"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="31" Y="1268"/>
+        <TopLine Value="1253"/>
+        <UsageCount Value="47"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="32" Y="1595"/>
+        <TopLine Value="1593"/>
+        <UsageCount Value="31"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\objpas.pp"/>
+        <UnitName Value="objpas"/>
+        <CursorPos X="8" Y="28"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="6"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\objpash.inc"/>
+        <CursorPos X="30" Y="206"/>
+        <TopLine Value="190"/>
+        <UsageCount Value="6"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\system.pp"/>
+        <UnitName Value="System"/>
+        <CursorPos X="4" Y="506"/>
+        <TopLine Value="231"/>
+        <UsageCount Value="6"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="googlewebapi_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="googlewebapi_proxy"/>
+        <CursorPos X="10" Y="104"/>
+        <TopLine Value="90"/>
+        <UsageCount Value="66"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="..\..\..\v0.2\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="33" Y="291"/>
+        <TopLine Value="277"/>
+        <UsageCount Value="6"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="3" Y="1174"/>
+        <TopLine Value="1170"/>
+        <UsageCount Value="8"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <UnitName Value="synapse_http_protocol"/>
+        <CursorPos X="3" Y="154"/>
+        <TopLine Value="145"/>
+        <UsageCount Value="11"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="D:\Lazarus\others_package\synapse\httpsend.pas"/>
+        <UnitName Value="httpsend"/>
+        <CursorPos X="15" Y="108"/>
+        <TopLine Value="96"/>
+        <UsageCount Value="9"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTP.pas"/>
+        <UnitName Value="IdHTTP"/>
+        <CursorPos X="49" Y="343"/>
+        <TopLine Value="331"/>
+        <UsageCount Value="10"/>
+      </Unit38>
+      <Unit39>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTPHeaderInfo.pas"/>
+        <UnitName Value="IdHTTPHeaderInfo"/>
+        <CursorPos X="70" Y="13"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="9"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHeaderList.pas"/>
+        <UnitName Value="IdHeaderList"/>
+        <CursorPos X="22" Y="157"/>
+        <TopLine Value="145"/>
+        <UsageCount Value="10"/>
+      </Unit40>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\LazarusClean\others_package\ics\latest_distr\Delphi\Vc32\;..\..\;D:\LazarusClean\others_package\synapse\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="..\..\"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="7">
+      <Item1>
+        <Source Value="home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.

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 := '<html>' +
+              '<head>'+
+                '<title>'+
+                  'The Web Service Toolkit generated Metadata table'+
+                '</title>'+
+                '<body>' +
+                  '<p BGCOLOR="#DDEEFF"><FONT FACE="Arial" COLOR="#0000A0" SIZE="+2">The following repositories has available. Click on the link to view the corresponding WSDL.</FONT></p>'+
+                  '<table width="100%">' +
+                    '<tr>';
+                    
+  for i := 0 to Pred(r.GetCount()) do
+    Result := Result + '<td align="center">' +
+                          Format('<a href="%s">',[sSEPARATOR+sSERVICES_PREFIXE+sSEPARATOR+sWSDL+sSEPARATOR+r.GetRepositoryName(i)])+
+                          r.GetRepositoryName(i) +
+                          '</a>'+
+                      '</td>';
+    
+  Result := Result +
+                    '</tr>'+
+                  '</table>'+
+                '</body>'+
+              '</head>'+
+            '</html>';
+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.

wst/tags/3.1/tests/http_server/wst_http_server.lpi

@@ -0,0 +1,709 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="5"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="indylaz"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="73">
+      <Unit0>
+        <Filename Value="wst_http_server.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="wst_http_server"/>
+        <CursorPos X="30" Y="29"/>
+        <TopLine Value="19"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="202"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="app_object.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="app_object"/>
+        <CursorPos X="1" Y="258"/>
+        <TopLine Value="237"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="202"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Core\IdSocketHandle.pas"/>
+        <UnitName Value="IdSocketHandle"/>
+        <CursorPos X="9" Y="126"/>
+        <TopLine Value="118"/>
+        <UsageCount Value="7"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdComponent.pas"/>
+        <UnitName Value="IdComponent"/>
+        <CursorPos X="27" Y="64"/>
+        <TopLine Value="50"/>
+        <UsageCount Value="7"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdCompilerDefines.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="7"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Core\IdContext.pas"/>
+        <UnitName Value="IdContext"/>
+        <CursorPos X="3" Y="81"/>
+        <TopLine Value="70"/>
+        <UsageCount Value="5"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdCustomHTTPServer.pas"/>
+        <UnitName Value="IdCustomHTTPServer"/>
+        <CursorPos X="16" Y="167"/>
+        <TopLine Value="148"/>
+        <UsageCount Value="1"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTPHeaderInfo.pas"/>
+        <UnitName Value="IdHTTPHeaderInfo"/>
+        <CursorPos X="25" Y="127"/>
+        <TopLine Value="99"/>
+        <UsageCount Value="1"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdGlobal.pas"/>
+        <UnitName Value="IdGlobal"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="7"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdBaseComponent.pas"/>
+        <UnitName Value="IdBaseComponent"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="69"/>
+        <UsageCount Value="7"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\win32\classes.pp"/>
+        <UnitName Value="Classes"/>
+        <CursorPos X="14" Y="35"/>
+        <TopLine Value="19"/>
+        <UsageCount Value="5"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="14" Y="566"/>
+        <TopLine Value="554"/>
+        <UsageCount Value="5"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\streams.inc"/>
+        <CursorPos X="7" Y="143"/>
+        <TopLine Value="118"/>
+        <UsageCount Value="5"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdResourceStringsProtocols.pas"/>
+        <UnitName Value="IdResourceStringsProtocols"/>
+        <CursorPos X="3" Y="900"/>
+        <TopLine Value="889"/>
+        <UsageCount Value="5"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdURI.pas"/>
+        <UnitName Value="IdURI"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="37"/>
+        <UsageCount Value="5"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\wstringh.inc"/>
+        <CursorPos X="11" Y="30"/>
+        <TopLine Value="19"/>
+        <UsageCount Value="5"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\wstrings.inc"/>
+        <CursorPos X="3" Y="938"/>
+        <TopLine Value="934"/>
+        <UsageCount Value="5"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\server_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="56" Y="332"/>
+        <TopLine Value="319"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="200"/>
+        <Bookmarks Count="2">
+          <Item0 X="28" Y="60" ID="0"/>
+          <Item1 X="21" Y="169" ID="2"/>
+        </Bookmarks>
+        <Loaded Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="75" Y="817"/>
+        <TopLine Value="811"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="201"/>
+        <Bookmarks Count="1">
+          <Item0 X="52" Y="707" ID="1"/>
+        </Bookmarks>
+        <Loaded Value="True"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\server_service_imputils.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_service_imputils"/>
+        <CursorPos X="1" Y="50"/>
+        <TopLine Value="61"/>
+        <UsageCount Value="201"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="..\..\server_binary_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="44" Y="97"/>
+        <TopLine Value="85"/>
+        <UsageCount Value="200"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="..\..\server_service_soap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="3" Y="160"/>
+        <TopLine Value="113"/>
+        <UsageCount Value="200"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="..\tcp_server\calculator\calculator.pas"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="5" Y="84"/>
+        <TopLine Value="65"/>
+        <UsageCount Value="165"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="..\tcp_server\calculator\srv\calculator_imp.pas"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="24" Y="18"/>
+        <TopLine Value="14"/>
+        <UsageCount Value="126"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="..\tcp_server\calculator\srv\calculator_binder.pas"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="165"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="1" Y="925"/>
+        <TopLine Value="913"/>
+        <UsageCount Value="13"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="D:\Lazarus\lcl\lresources.pp"/>
+        <UnitName Value="LResources"/>
+        <CursorPos X="25" Y="272"/>
+        <TopLine Value="258"/>
+        <UsageCount Value="5"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="..\..\metadata_wsdl.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_wsdl"/>
+        <CursorPos X="39" Y="549"/>
+        <TopLine Value="537"/>
+        <EditorIndex Value="7"/>
+        <UsageCount Value="201"/>
+        <Bookmarks Count="1">
+          <Item0 X="23" Y="440" ID="3"/>
+        </Bookmarks>
+        <Loaded Value="True"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="..\..\metadata_repository.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_repository"/>
+        <CursorPos X="31" Y="629"/>
+        <TopLine Value="72"/>
+        <UsageCount Value="201"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="15" Y="475"/>
+        <TopLine Value="472"/>
+        <UsageCount Value="7"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\xml\xmlwrite.pp"/>
+        <UnitName Value="XMLWrite"/>
+        <CursorPos X="15" Y="74"/>
+        <TopLine Value="50"/>
+        <UsageCount Value="6"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="7" Y="73"/>
+        <TopLine Value="96"/>
+        <UsageCount Value="12"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="1" Y="249"/>
+        <TopLine Value="235"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="59"/>
+        <Loaded Value="True"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpash.inc"/>
+        <CursorPos X="40" Y="165"/>
+        <TopLine Value="279"/>
+        <UsageCount Value="5"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpas.inc"/>
+        <CursorPos X="11" Y="351"/>
+        <TopLine Value="345"/>
+        <UsageCount Value="3"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTPServer.pas"/>
+        <UnitName Value="IdHTTPServer"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="9"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="D:\lazarusClean\lcl\lresources.pp"/>
+        <UnitName Value="LResources"/>
+        <CursorPos X="3" Y="934"/>
+        <TopLine Value="931"/>
+        <UsageCount Value="5"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdSysVCL.pas"/>
+        <UnitName Value="IdSysVCL"/>
+        <CursorPos X="1" Y="176"/>
+        <TopLine Value="165"/>
+        <UsageCount Value="2"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\System\IdStackBSDBase.pas"/>
+        <UnitName Value="IdStackBSDBase"/>
+        <CursorPos X="35" Y="456"/>
+        <TopLine Value="446"/>
+        <UsageCount Value="2"/>
+      </Unit38>
+      <Unit39>
+        <Filename Value="..\tcp_server\calculator\srv\calculator.lrs"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="1"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\xml\xmlwrite.pp"/>
+        <UnitName Value="XMLWrite"/>
+        <CursorPos X="11" Y="28"/>
+        <TopLine Value="16"/>
+        <UsageCount Value="9"/>
+      </Unit40>
+      <Unit41>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="52" Y="298"/>
+        <TopLine Value="278"/>
+        <UsageCount Value="6"/>
+      </Unit41>
+      <Unit42>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\stringl.inc"/>
+        <CursorPos X="19" Y="636"/>
+        <TopLine Value="634"/>
+        <UsageCount Value="0"/>
+      </Unit42>
+      <Unit43>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <CursorPos X="10" Y="80"/>
+        <TopLine Value="69"/>
+        <UsageCount Value="0"/>
+      </Unit43>
+      <Unit44>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <CursorPos X="37" Y="453"/>
+        <TopLine Value="451"/>
+        <UsageCount Value="0"/>
+      </Unit44>
+      <Unit45>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="3" Y="370"/>
+        <TopLine Value="368"/>
+        <UsageCount Value="0"/>
+      </Unit45>
+      <Unit46>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\objpas.pp"/>
+        <UnitName Value="objpas"/>
+        <CursorPos X="8" Y="26"/>
+        <TopLine Value="14"/>
+        <UsageCount Value="0"/>
+      </Unit46>
+      <Unit47>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="3" Y="741"/>
+        <TopLine Value="705"/>
+        <UsageCount Value="6"/>
+      </Unit47>
+      <Unit48>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\wstringh.inc"/>
+        <CursorPos X="5" Y="67"/>
+        <TopLine Value="42"/>
+        <UsageCount Value="0"/>
+      </Unit48>
+      <Unit49>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\wstrings.inc"/>
+        <CursorPos X="3" Y="825"/>
+        <TopLine Value="820"/>
+        <UsageCount Value="0"/>
+      </Unit49>
+      <Unit50>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\classes.pp"/>
+        <UnitName Value="Classes"/>
+        <CursorPos X="38" Y="2"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="3"/>
+      </Unit50>
+      <Unit51>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\writer.inc"/>
+        <CursorPos X="3" Y="585"/>
+        <TopLine Value="579"/>
+        <UsageCount Value="1"/>
+      </Unit51>
+      <Unit52>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\compon.inc"/>
+        <CursorPos X="25" Y="367"/>
+        <TopLine Value="364"/>
+        <UsageCount Value="1"/>
+      </Unit52>
+      <Unit53>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="15" Y="269"/>
+        <TopLine Value="258"/>
+        <UsageCount Value="2"/>
+      </Unit53>
+      <Unit54>
+        <Filename Value="..\..\metadata_service.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_service"/>
+        <CursorPos X="25" Y="147"/>
+        <TopLine Value="145"/>
+        <UsageCount Value="187"/>
+      </Unit54>
+      <Unit55>
+        <Filename Value="..\..\metadata_service_imp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_service_imp"/>
+        <CursorPos X="63" Y="107"/>
+        <TopLine Value="86"/>
+        <UsageCount Value="186"/>
+      </Unit55>
+      <Unit56>
+        <Filename Value="..\..\metadata_service_binder.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_service_binder"/>
+        <CursorPos X="53" Y="11"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="186"/>
+      </Unit56>
+      <Unit57>
+        <Filename Value="..\..\metadata_service.lrs"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="4"/>
+      </Unit57>
+      <Unit58>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\persist.inc"/>
+        <CursorPos X="3" Y="37"/>
+        <TopLine Value="117"/>
+        <UsageCount Value="6"/>
+      </Unit58>
+      <Unit59>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\rtlconsts.pp"/>
+        <UnitName Value="RtlConsts"/>
+        <CursorPos X="7" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="6"/>
+      </Unit59>
+      <Unit60>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\rtlconst.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="6"/>
+      </Unit60>
+      <Unit61>
+        <Filename Value="..\calculator\srv\calculator_imp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="65" Y="3"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="123"/>
+        <Loaded Value="True"/>
+      </Unit61>
+      <Unit62>
+        <Filename Value="..\calculator\srv\calculator_binder.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="69" Y="51"/>
+        <TopLine Value="39"/>
+        <UsageCount Value="123"/>
+      </Unit62>
+      <Unit63>
+        <Filename Value="..\calculator\calculator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="31" Y="98"/>
+        <TopLine Value="51"/>
+        <UsageCount Value="123"/>
+      </Unit63>
+      <Unit64>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\heaph.inc"/>
+        <CursorPos X="10" Y="96"/>
+        <TopLine Value="83"/>
+        <UsageCount Value="0"/>
+      </Unit64>
+      <Unit65>
+        <Filename Value="..\..\imp_utils.pas"/>
+        <UnitName Value="imp_utils"/>
+        <CursorPos X="1" Y="55"/>
+        <TopLine Value="43"/>
+        <UsageCount Value="10"/>
+      </Unit65>
+      <Unit66>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\intfh.inc"/>
+        <CursorPos X="10" Y="27"/>
+        <TopLine Value="9"/>
+        <UsageCount Value="4"/>
+      </Unit66>
+      <Unit67>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\win\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="8" Y="33"/>
+        <TopLine Value="34"/>
+        <UsageCount Value="5"/>
+      </Unit67>
+      <Unit68>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\sysutilh.inc"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="214"/>
+        <UsageCount Value="5"/>
+      </Unit68>
+      <Unit69>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\stringl.inc"/>
+        <CursorPos X="3" Y="1063"/>
+        <TopLine Value="1060"/>
+        <UsageCount Value="5"/>
+      </Unit69>
+      <Unit70>
+        <Filename Value="..\calculator\srv\logger_extension.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="logger_extension"/>
+        <CursorPos X="32" Y="11"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="36"/>
+        <Loaded Value="True"/>
+      </Unit70>
+      <Unit71>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="13"/>
+      </Unit71>
+      <Unit72>
+        <Filename Value="..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="58" Y="47"/>
+        <TopLine Value="34"/>
+        <UsageCount Value="13"/>
+      </Unit72>
+    </Units>
+    <JumpHistory Count="21" HistoryIndex="20">
+      <Position1>
+        <Filename Value="wst_http_server.pas"/>
+        <Caret Line="29" Column="30" TopLine="19"/>
+      </Position1>
+      <Position2>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="260" Column="21" TopLine="242"/>
+      </Position2>
+      <Position3>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position3>
+      <Position4>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="189" Column="1" TopLine="168"/>
+      </Position4>
+      <Position5>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position5>
+      <Position6>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="93" Column="1" TopLine="72"/>
+      </Position6>
+      <Position7>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position7>
+      <Position8>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="72" Column="18" TopLine="59"/>
+      </Position8>
+      <Position9>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="123" Column="39" TopLine="108"/>
+      </Position9>
+      <Position10>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="68" Column="1" TopLine="47"/>
+      </Position10>
+      <Position11>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position11>
+      <Position12>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="34" Column="31" TopLine="23"/>
+      </Position12>
+      <Position13>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="163" Column="1" TopLine="143"/>
+      </Position13>
+      <Position14>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position14>
+      <Position15>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="164" Column="48" TopLine="163"/>
+      </Position15>
+      <Position16>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position16>
+      <Position17>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="36" Column="33" TopLine="25"/>
+      </Position17>
+      <Position18>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="164" Column="48" TopLine="153"/>
+      </Position18>
+      <Position19>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="269" Column="3" TopLine="263"/>
+      </Position19>
+      <Position20>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="248" Column="5" TopLine="239"/>
+      </Position20>
+      <Position21>
+        <Filename Value="app_object.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position21>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\..\;..\calculator\;..\calculator\srv\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="..\..\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="6">
+      <Item1>
+        <Source Value="..\..\metadata_repository.pas"/>
+        <Line Value="309"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="459"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="468"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="431"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="181"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\..\server_service_intf.pas"/>
+        <Line Value="630"/>
+      </Item6>
+    </BreakPoints>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

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.

wst/tags/3.1/tests/metadata_browser/metadata_browser.lpi

@@ -0,0 +1,326 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="indylaz"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="16">
+      <Unit0>
+        <Filename Value="metadata_browser.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_browser"/>
+        <CursorPos X="25" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="68"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <ComponentName Value="fMain"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="umain.lrs"/>
+        <UnitName Value="umain"/>
+        <CursorPos X="15" Y="49"/>
+        <TopLine Value="34"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="68"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\metadata_service_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_service_proxy"/>
+        <CursorPos X="61" Y="35"/>
+        <TopLine Value="23"/>
+        <UsageCount Value="68"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="1" Y="1196"/>
+        <TopLine Value="1185"/>
+        <UsageCount Value="5"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\indy_http_protocol.pas"/>
+        <UnitName Value="indy_http_protocol"/>
+        <CursorPos X="27" Y="155"/>
+        <TopLine Value="144"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="18"/>
+        <Loaded Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="34" Y="86"/>
+        <TopLine Value="117"/>
+        <UsageCount Value="5"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="1" Y="216"/>
+        <TopLine Value="189"/>
+        <UsageCount Value="5"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="30" Y="134"/>
+        <TopLine Value="134"/>
+        <UsageCount Value="5"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\binary_formatter.pas"/>
+        <UnitName Value="binary_formatter"/>
+        <CursorPos X="38" Y="35"/>
+        <TopLine Value="32"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="17"/>
+        <Loaded Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <UnitName Value="ics_http_protocol"/>
+        <CursorPos X="3" Y="24"/>
+        <TopLine Value="13"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="13"/>
+        <Loaded Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\metadata_service.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_service"/>
+        <CursorPos X="35" Y="106"/>
+        <TopLine Value="99"/>
+        <UsageCount Value="63"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\objpash.inc"/>
+        <CursorPos X="23" Y="118"/>
+        <TopLine Value="107"/>
+        <UsageCount Value="5"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="49" Y="650"/>
+        <TopLine Value="639"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="17"/>
+        <Loaded Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <UnitName Value="synapse_http_protocol"/>
+        <CursorPos X="34" Y="102"/>
+        <TopLine Value="92"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="17"/>
+        <Loaded Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\others_package\ics\latest_distr\Delphi\Vc32\WSockBuf.pas"/>
+        <UnitName Value="WSockBuf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="10"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\ics_tcp_protocol.pas"/>
+        <UnitName Value="ics_tcp_protocol"/>
+        <CursorPos X="35" Y="83"/>
+        <TopLine Value="31"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit15>
+    </Units>
+    <JumpHistory Count="22" HistoryIndex="21">
+      <Position1>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="23" TopLine="40"/>
+      </Position1>
+      <Position2>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="155" Column="3" TopLine="147"/>
+      </Position2>
+      <Position3>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="153" Column="71" TopLine="147"/>
+      </Position3>
+      <Position4>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="167" Column="35" TopLine="149"/>
+      </Position4>
+      <Position5>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="22" TopLine="40"/>
+      </Position5>
+      <Position6>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="58" Column="16" TopLine="49"/>
+      </Position6>
+      <Position7>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="39" Column="23" TopLine="33"/>
+      </Position7>
+      <Position8>
+        <Filename Value="..\..\synapse_http_protocol.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position8>
+      <Position9>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="41" TopLine="40"/>
+      </Position9>
+      <Position10>
+        <Filename Value="..\..\indy_http_protocol.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position10>
+      <Position11>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="53" TopLine="40"/>
+      </Position11>
+      <Position12>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position12>
+      <Position13>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="53" TopLine="40"/>
+      </Position13>
+      <Position14>
+        <Filename Value="umain.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position14>
+      <Position15>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <Caret Line="108" Column="36" TopLine="97"/>
+      </Position15>
+      <Position16>
+        <Filename Value="..\..\ics_http_protocol.pas"/>
+        <Caret Line="24" Column="3" TopLine="13"/>
+      </Position16>
+      <Position17>
+        <Filename Value="umain.pas"/>
+        <Caret Line="22" Column="15" TopLine="22"/>
+      </Position17>
+      <Position18>
+        <Filename Value="umain.pas"/>
+        <Caret Line="46" Column="67" TopLine="36"/>
+      </Position18>
+      <Position19>
+        <Filename Value="umain.pas"/>
+        <Caret Line="47" Column="17" TopLine="36"/>
+      </Position19>
+      <Position20>
+        <Filename Value="umain.pas"/>
+        <Caret Line="47" Column="16" TopLine="36"/>
+      </Position20>
+      <Position21>
+        <Filename Value="..\..\ics_tcp_protocol.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position21>
+      <Position22>
+        <Filename Value="umain.pas"/>
+        <Caret Line="162" Column="5" TopLine="143"/>
+      </Position22>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="metadata_browser.exe"/>
+    </Target>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\..\;D:\lazarusClean\others_package\synapse\;D:\lazarusClean\others_package\ics\latest_distr\Delphi\Vc32\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="8">
+      <Item1>
+        <Source Value="..\..\server_service_soap.pas"/>
+        <Line Value="112"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\metadata_repository.pas"/>
+        <Line Value="309"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="459"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="468"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="431"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="298"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\..\metadata_wsdl.pas"/>
+        <Line Value="181"/>
+      </Item7>
+      <Item8>
+        <Source Value="..\..\metadata_service_proxy.pas"/>
+        <Line Value="43"/>
+      </Item8>
+    </BreakPoints>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

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.
+

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

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
+]);

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.
+

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.

wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpi

@@ -0,0 +1,381 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="5"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="38">
+      <Unit0>
+        <Filename Value="tcp_gui_server.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcp_gui_server"/>
+        <CursorPos X="25" Y="3"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <ComponentName Value="fMain"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="umain.lrs"/>
+        <UnitName Value="umain"/>
+        <CursorPos X="41" Y="88"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="server_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_unit"/>
+        <CursorPos X="4" Y="245"/>
+        <TopLine Value="144"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocket.pas"/>
+        <UnitName Value="WSocket"/>
+        <CursorPos X="27" Y="982"/>
+        <TopLine Value="968"/>
+        <UsageCount Value="9"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocketS.pas"/>
+        <UnitName Value="WSocketS"/>
+        <CursorPos X="32" Y="140"/>
+        <TopLine Value="136"/>
+        <UsageCount Value="9"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="50"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\..\..\server_service_intf.pas"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="17" Y="203"/>
+        <TopLine Value="70"/>
+        <UsageCount Value="41"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\..\..\server_service_imputils.pas"/>
+        <UnitName Value="server_service_imputils"/>
+        <CursorPos X="29" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="41"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSockBuf.pas"/>
+        <UnitName Value="WSockBuf"/>
+        <CursorPos X="3" Y="163"/>
+        <TopLine Value="157"/>
+        <UsageCount Value="10"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\basic_stub.pas"/>
+        <UnitName Value="basic_stub"/>
+        <CursorPos X="39" Y="16"/>
+        <TopLine Value="8"/>
+        <UsageCount Value="32"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\basic.pas"/>
+        <UnitName Value="basic"/>
+        <CursorPos X="5" Y="3"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="38"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\basic_intfimpunit.pas"/>
+        <UnitName Value="basic_intfimpunit"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="7"/>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\basic_service_implementation.pas"/>
+        <UnitName Value="basic_service_implementation"/>
+        <CursorPos X="56" Y="33"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="32"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\..\..\server_service_soap.pas"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="45" Y="811"/>
+        <TopLine Value="807"/>
+        <UsageCount Value="30"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="..\..\..\..\server_binary_formatter.pas"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="37" Y="23"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="30"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\..\..\binary_util_imp.inc"/>
+        <CursorPos X="3" Y="426"/>
+        <TopLine Value="424"/>
+        <UsageCount Value="5"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\..\..\binary_util_h.inc"/>
+        <CursorPos X="6" Y="180"/>
+        <TopLine Value="166"/>
+        <UsageCount Value="3"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\basic_imp.pas"/>
+        <UnitName Value="basic_imp"/>
+        <CursorPos X="3" Y="39"/>
+        <TopLine Value="9"/>
+        <UsageCount Value="4"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\basic_binder.pas"/>
+        <UnitName Value="basic_binder"/>
+        <CursorPos X="13" Y="67"/>
+        <TopLine Value="44"/>
+        <UsageCount Value="4"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="15" Y="190"/>
+        <TopLine Value="178"/>
+        <UsageCount Value="3"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="26" Y="419"/>
+        <TopLine Value="412"/>
+        <UsageCount Value="3"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="3" Y="745"/>
+        <TopLine Value="743"/>
+        <UsageCount Value="4"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="..\..\..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="3" Y="814"/>
+        <TopLine Value="796"/>
+        <UsageCount Value="3"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="calculator\calculator.pas"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="47" Y="58"/>
+        <TopLine Value="28"/>
+        <UsageCount Value="87"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="calculator\srv\calculator_imp.pas"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="55" Y="95"/>
+        <TopLine Value="77"/>
+        <UsageCount Value="87"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="calculator\srv\calculator_binder.pas"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="40" Y="126"/>
+        <TopLine Value="101"/>
+        <UsageCount Value="87"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="..\..\server_service_soap.pas"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="15" Y="43"/>
+        <TopLine Value="29"/>
+        <UsageCount Value="26"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="..\..\server_binary_formatter.pas"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="13" Y="83"/>
+        <TopLine Value="73"/>
+        <UsageCount Value="28"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="..\..\server_service_intf.pas"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="9" Y="429"/>
+        <TopLine Value="417"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="1" Y="22"/>
+        <TopLine Value="17"/>
+        <UsageCount Value="38"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="31"/>
+        <UsageCount Value="9"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="3" Y="328"/>
+        <TopLine Value="317"/>
+        <UsageCount Value="26"/>
+        <Bookmarks Count="1">
+          <Item0 X="24" Y="642" ID="1"/>
+        </Bookmarks>
+      </Unit31>
+      <Unit32>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="3" Y="872"/>
+        <TopLine Value="874"/>
+        <UsageCount Value="20"/>
+        <Bookmarks Count="1">
+          <Item0 X="16" Y="387" ID="2"/>
+        </Bookmarks>
+      </Unit32>
+      <Unit33>
+        <Filename Value="..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="67" Y="167"/>
+        <TopLine Value="149"/>
+        <UsageCount Value="12"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="78"/>
+        <UsageCount Value="8"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="..\calculator\calculator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="..\calculator\srv\calculator_imp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="48" Y="117"/>
+        <TopLine Value="110"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="..\calculator\srv\calculator_binder.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="80" Y="174"/>
+        <TopLine Value="170"/>
+        <UsageCount Value="20"/>
+      </Unit37>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\;..\calculator\;..\calculator\srv\;..\..\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="5">
+      <Item1>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\basic_binder.pas"/>
+        <Line Value="62"/>
+      </Item5>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

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

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
+]);

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.
+

wst/tags/3.1/tests/test_float_to_str/project1.lpi

@@ -0,0 +1,171 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <LazDoc Paths=""/>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="5">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="project1"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="unit1.lrs"/>
+        <UnitName Value="Unit1"/>
+        <CursorPos X="75" Y="45"/>
+        <TopLine Value="34"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <CursorPos X="10" Y="164"/>
+        <TopLine Value="100"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <CursorPos X="42" Y="1764"/>
+        <TopLine Value="1797"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysinth.inc"/>
+        <CursorPos X="3" Y="95"/>
+        <TopLine Value="76"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit4>
+    </Units>
+    <JumpHistory Count="7" HistoryIndex="6">
+      <Position1>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <Caret Line="130" Column="49" TopLine="120"/>
+      </Position1>
+      <Position2>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <Caret Line="107" Column="10" TopLine="107"/>
+      </Position2>
+      <Position3>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position3>
+      <Position4>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <Caret Line="1923" Column="13" TopLine="1917"/>
+      </Position4>
+      <Position5>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <Caret Line="1923" Column="16" TopLine="1917"/>
+      </Position5>
+      <Position6>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <Caret Line="1770" Column="42" TopLine="1737"/>
+      </Position6>
+      <Position7>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <Caret Line="1764" Column="42" TopLine="1737"/>
+      </Position7>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="9">
+      <Item1>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+      <Item8>
+        <Source Value="..\..\base_service_intf.pas"/>
+        <Line Value="505"/>
+      </Item8>
+      <Item9>
+        <Source Value="..\..\base_binary_formatter.pas"/>
+        <Line Value="928"/>
+      </Item9>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

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

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
+]);

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.
+

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.

wst/tags/3.1/tests/test_suite/wst_test_suite.lpi

@@ -0,0 +1,501 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="6"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-a >E:\Inoussa\Sources\lazarus\wst\v0.3\tests\test_suite\obj\res.xml"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FPCUnitTestRunner"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="46">
+      <Unit0>
+        <Filename Value="wst_test_suite.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="wst_test_suite"/>
+        <CursorPos X="69" Y="11"/>
+        <TopLine Value="9"/>
+        <UsageCount Value="148"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="testformatter_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testformatter_unit"/>
+        <CursorPos X="55" Y="66"/>
+        <TopLine Value="150"/>
+        <EditorIndex Value="9"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\..\server_service_soap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="20" Y="205"/>
+        <TopLine Value="171"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\soap_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="soap_formatter"/>
+        <CursorPos X="8" Y="97"/>
+        <TopLine Value="86"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="39" Y="180"/>
+        <TopLine Value="171"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="3" Y="106"/>
+        <TopLine Value="121"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="1" Y="1082"/>
+        <TopLine Value="1061"/>
+        <EditorIndex Value="7"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\binary_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="binary_formatter"/>
+        <CursorPos X="15" Y="44"/>
+        <TopLine Value="33"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="148"/>
+        <Loaded Value="True"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\binary_streamer.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="32" Y="38"/>
+        <TopLine Value="22"/>
+        <UsageCount Value="148"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\server_binary_formatter.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="5" Y="136"/>
+        <TopLine Value="92"/>
+        <UsageCount Value="148"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\fpcunit\fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="39" Y="66"/>
+        <TopLine Value="66"/>
+        <UsageCount Value="6"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\fpcunit\testregistry.pp"/>
+        <UnitName Value="testregistry"/>
+        <CursorPos X="11" Y="29"/>
+        <TopLine Value="35"/>
+        <UsageCount Value="9"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="11" Y="216"/>
+        <TopLine Value="230"/>
+        <UsageCount Value="3"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
+        <CursorPos X="10" Y="137"/>
+        <TopLine Value="127"/>
+        <UsageCount Value="1"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
+        <CursorPos X="23" Y="1007"/>
+        <TopLine Value="1005"/>
+        <UsageCount Value="1"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\systemh.inc"/>
+        <CursorPos X="65" Y="452"/>
+        <TopLine Value="441"/>
+        <UsageCount Value="6"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\system.pp"/>
+        <UnitName Value="System"/>
+        <CursorPos X="20" Y="1012"/>
+        <TopLine Value="1011"/>
+        <UsageCount Value="6"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="3" Y="625"/>
+        <TopLine Value="623"/>
+        <UsageCount Value="1"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\metadata_repository.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_repository"/>
+        <CursorPos X="3" Y="79"/>
+        <TopLine Value="70"/>
+        <UsageCount Value="123"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="15" Y="579"/>
+        <TopLine Value="565"/>
+        <UsageCount Value="5"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="testmetadata_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="testmetadata_unit"/>
+        <CursorPos X="83" Y="119"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="8"/>
+        <UsageCount Value="116"/>
+        <Loaded Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="..\..\ws_helper\metadata_generator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_generator"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="31"/>
+        <UsageCount Value="116"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="..\..\ws_helper\parserdefs.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="parserdefs"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="116"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="21" Y="81"/>
+        <TopLine Value="71"/>
+        <UsageCount Value="2"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\testregistry.pp"/>
+        <UnitName Value="testregistry"/>
+        <CursorPos X="11" Y="29"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="3"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\heaph.inc"/>
+        <CursorPos X="10" Y="87"/>
+        <TopLine Value="61"/>
+        <UsageCount Value="2"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\inc\heap.inc"/>
+        <CursorPos X="3" Y="235"/>
+        <TopLine Value="223"/>
+        <UsageCount Value="2"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="3" Y="1248"/>
+        <TopLine Value="1238"/>
+        <UsageCount Value="2"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="..\..\metadata_wsdl.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="metadata_wsdl"/>
+        <CursorPos X="38" Y="148"/>
+        <TopLine Value="142"/>
+        <UsageCount Value="108"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="15" Y="429"/>
+        <TopLine Value="413"/>
+        <UsageCount Value="4"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\classes.pp"/>
+        <UnitName Value="Classes"/>
+        <CursorPos X="14" Y="32"/>
+        <TopLine Value="13"/>
+        <UsageCount Value="6"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="14" Y="149"/>
+        <TopLine Value="138"/>
+        <UsageCount Value="6"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="3" Y="29"/>
+        <TopLine Value="27"/>
+        <UsageCount Value="6"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
+        <CursorPos X="13" Y="235"/>
+        <TopLine Value="215"/>
+        <UsageCount Value="8"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutils.inc"/>
+        <CursorPos X="9" Y="110"/>
+        <TopLine Value="106"/>
+        <UsageCount Value="7"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\heaptrc.pp"/>
+        <UnitName Value="heaptrc"/>
+        <CursorPos X="40" Y="1168"/>
+        <TopLine Value="1190"/>
+        <UsageCount Value="7"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <CursorPos X="3" Y="187"/>
+        <TopLine Value="175"/>
+        <UsageCount Value="9"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="..\..\server_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="35" Y="379"/>
+        <TopLine Value="376"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="42"/>
+        <Loaded Value="True"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="23"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="19"/>
+        <Loaded Value="True"/>
+      </Unit38>
+      <Unit39>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="3" Y="316"/>
+        <TopLine Value="304"/>
+        <UsageCount Value="8"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="3" Y="407"/>
+        <TopLine Value="404"/>
+        <UsageCount Value="8"/>
+      </Unit40>
+      <Unit41>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="3" Y="474"/>
+        <TopLine Value="471"/>
+        <UsageCount Value="8"/>
+      </Unit41>
+      <Unit42>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
+        <CursorPos X="27" Y="121"/>
+        <TopLine Value="104"/>
+        <UsageCount Value="8"/>
+      </Unit42>
+      <Unit43>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpas.inc"/>
+        <CursorPos X="9" Y="166"/>
+        <TopLine Value="142"/>
+        <UsageCount Value="8"/>
+      </Unit43>
+      <Unit44>
+        <Filename Value="D:\Lazarus\components\fpcunit\guitestrunner.pas"/>
+        <ComponentName Value="GUITestRunner"/>
+        <HasResources Value="True"/>
+        <UnitName Value="GuiTestRunner"/>
+        <CursorPos X="34" Y="32"/>
+        <TopLine Value="25"/>
+        <UsageCount Value="8"/>
+      </Unit44>
+      <Unit45>
+        <Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\fpcunit.pp"/>
+        <UnitName Value="fpcunit"/>
+        <CursorPos X="26" Y="231"/>
+        <TopLine Value="193"/>
+        <UsageCount Value="9"/>
+      </Unit45>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\..\;..\..\ws_helper\"/>
+      <UnitOutputDirectory Value="obj"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="21">
+      <Item1>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
+        <Line Value="69"/>
+      </Item5>
+      <Item6>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
+        <Line Value="567"/>
+      </Item6>
+      <Item7>
+        <Source Value="..\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
+        <Line Value="83"/>
+      </Item7>
+      <Item8>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="572"/>
+      </Item8>
+      <Item9>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="587"/>
+      </Item9>
+      <Item10>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="588"/>
+      </Item10>
+      <Item11>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="571"/>
+      </Item11>
+      <Item12>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="570"/>
+      </Item12>
+      <Item13>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="568"/>
+      </Item13>
+      <Item14>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="366"/>
+      </Item14>
+      <Item15>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="337"/>
+      </Item15>
+      <Item16>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="194"/>
+      </Item16>
+      <Item17>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="349"/>
+      </Item17>
+      <Item18>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="363"/>
+      </Item18>
+      <Item19>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="821"/>
+      </Item19>
+      <Item20>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="809"/>
+      </Item20>
+      <Item21>
+        <Source Value="testformatter_unit.pas"/>
+        <Line Value="909"/>
+      </Item21>
+    </BreakPoints>
+    <Watches Count="2">
+      <Item1>
+        <Expression Value="FScopeObject^.Name"/>
+      </Item1>
+      <Item2>
+        <Expression Value="AOwner^.DataType"/>
+      </Item2>
+    </Watches>
+  </Debugging>
+</CONFIG>

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.
+

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.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 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.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.

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.
+

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.
+

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.

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.
+

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.