pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Release 0.5 copy

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@242 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-08-15 01:48:46 +00:00
parent 7788fcc3f4
commit bbee29cb90
291 changed files with 98159 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

481
wst/tags/0.5/COPYING.LGPL Normal file
View File

@ -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!

26
wst/tags/0.5/COPYING.modifiedLGPL Normal file
View File

@ -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

1618
wst/tags/0.5/base_binary_formatter.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4533
wst/tags/0.5/base_service_intf.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1779
wst/tags/0.5/base_soap_formatter.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1471
wst/tags/0.5/base_xmlrpc_formatter.pas Normal file
View File

File diff suppressed because it is too large Load Diff

211
wst/tags/0.5/binary_formatter.pas Normal file
View File

@ -0,0 +1,211 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit binary_formatter;
interface
uses
Classes, SysUtils, TypInfo,
base_service_intf, service_intf, imp_utils,
base_binary_formatter;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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';
BeginObjectRead(s,nil);
s := StackTop().GetByIndex(0)^.Name;
If AnsiSameText(s,'Fault') Then Begin
BeginObjectRead(s,nil);
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;
BeginObjectRead(FCallTarget,nil);
FCallProcedureName := StackTop().GetByIndex(0)^.Name;
BeginObjectRead(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;
propMngr : IPropertyManager;
begin
Assert(Assigned(ASerializer));
Assert(Assigned(ATransport));
propMngr := ATransport.GetPropertyManager();
propMngr.SetProperty(
sCONTENT_TYPE,
sBINARY_CONTENT
);
propMngr.SetProperty(
sFORMAT,
sPROTOCOL_NAME
);
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.

522
wst/tags/0.5/binary_streamer.pas Normal file
View File

@ -0,0 +1,522 @@
{
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.
}
{$INCLUDE wst_global.inc}
{$RANGECHECKS OFF}
unit binary_streamer;
interface
uses
Classes, SysUtils, Types;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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 USE_INLINE}{$IFDEF ENDIAN_BIG}inline;{$ENDIF}{$ENDIF}
function Reverse_16(const AValue:Word):Word;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_32(const AValue:DWord):DWord;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_64(const AValue:QWord):QWord;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_Single(const AValue:Single):Single;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_Double(const AValue:Double):Double;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_Extended(const AValue:Extended):Extended;{$IFDEF USE_INLINE}inline;{$ENDIF}
function Reverse_Currency(const AValue:Currency):Currency;{$IFDEF USE_INLINE}inline;{$ENDIF}
implementation
{$IFDEF ENDIAN_BIG}
procedure ReverseBytes(var AData; const ALength : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
begin
end;
{$ELSE} // assume ENDIAN_LITTLE
procedure ReverseBytes(var AData; const ALength : Integer);
Var
i,j : PtrInt;
c : Byte;
pDt : {$IFDEF FPC}^Byte{$ELSE}PByteArray{$ENDIF};
begin
pDt := @AData;
j := ALength div 2;
For i := 0 To Pred(j) Do Begin
c := pDt{$IFNDEF FPC}^{$ENDIF}[i];
pDt[i] := pDt[(ALength - 1 ) - i];
pDt[(ALength - 1 ) - i] := c;
End;
end;
{$ENDIF}
function Reverse_16(const AValue:Word):Word;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,2)
end;
function Reverse_32(const AValue:DWord):DWord;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,4)
end;
function Reverse_64(const AValue:QWord):QWord;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,8)
end;
function Reverse_Single(const AValue:Single):Single;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,4)
end;
function Reverse_Double(const AValue:Double):Double;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,8)
end;
function Reverse_Extended(const AValue:Extended):Extended;{$IFDEF USE_INLINE}inline;{$ENDIF}
begin
Result := AValue;
ReverseBytes(Result,10);
end;
function Reverse_Currency(const AValue:Currency):Currency;{$IFDEF USE_INLINE}inline;{$ENDIF}
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;
{$IFDEF FPC}
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;
{$ELSE}
procedure TDataStore.WriteInt16U(const AData: TInt16U);
var
bffr : TInt16U;
begin
bffr := Reverse_16(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteInt16S(const AData: TInt16S);
var
bffr : TInt16U;
begin
bffr := Reverse_16(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteInt32U(const AData: TInt32U);
var
bffr : TInt32U;
begin
bffr := Reverse_32(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteInt32S(const AData: TInt32S);
var
bffr : TInt32U;
begin
bffr := Reverse_32(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteInt64U(const AData: TInt64U);
var
bffr : TInt64U;
begin
bffr := Reverse_64(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteInt64S(const AData: TInt64S);
var
bffr : TInt64U;
begin
bffr := Reverse_64(AData);
FStream.Write(bffr,SizeOf(AData));
end;
{$ENDIF}
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;
}
procedure TDataStore.WriteSingle(const AData: TFloat_Single_4);
var
bffr : TFloat_Single_4;
begin
bffr := Reverse_Single(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteDouble(const AData: TFloat_Double_8);
var
bffr : TFloat_Double_8;
begin
bffr := Reverse_Double(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteExtended(const AData: TFloat_Extended_10);
var
bffr : TFloat_Extended_10;
begin
bffr := Reverse_Extended(AData);
FStream.Write(bffr,SizeOf(AData));
end;
procedure TDataStore.WriteCurrency(const AData: TFloat_Currency_8);
var
bffr : TFloat_Currency_8;
begin
bffr := Reverse_Currency(AData);
FStream.Write(bffr,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.

277
wst/tags/0.5/config_objects.pas Normal file
View File

@ -0,0 +1,277 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit config_objects;
interface
uses SysUtils, Classes, base_service_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
TwstConfigItem = class(TBaseComplexRemotable);
TwstConfigService = class(TwstConfigItem)
private
FPooled: Boolean;
FPoolMax: PtrInt;
FPoolMin: PtrInt;
FTimeOut: PtrUInt;
FName: string;
public
function GetConfigText() : string;
published
property Name : string read FName write FName;
property PoolMax : PtrInt read FPoolMax write FPoolMax;
property PoolMin : PtrInt read FPoolMin write FPoolMin;
property Pooled : Boolean read FPooled write FPooled;
property TimeOut : PtrUInt read FTimeOut write FTimeOut;
end;
TwstConfigServiceArray = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TwstConfigService;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TwstConfigService Read GetItem;Default;
end;
TWstConfigurationObject = class(TBaseComplexRemotable)
private
FServices: TwstConfigServiceArray;
public
constructor Create();override;
destructor Destroy();override;
published
property Services : TwstConfigServiceArray read FServices write FServices;
end;
{$IFNDEF FPC}
function GetAppConfigDir(const AGlobal : Boolean) : string;
{$ENDIF}
function wst_GetConfigFileName():string;
function wst_GetConfigObject() : TWstConfigurationObject;
function wst_GetServiceConfig(const AName : string) : TwstConfigService ;
function wst_GetServiceConfigText(const AName : string) : string ;
procedure wst_CreateDefaultFile(ADest : TStream; AConfigObj : TWstConfigurationObject);overload;
procedure wst_CreateDefaultFile(const AFileName : string; AConfigObj : TWstConfigurationObject);overload;
implementation
uses
base_soap_formatter, server_service_intf,
{$IFNDEF FPC}
xmldom, wst_delphi_xml
{$ELSE}
DOM, XmlRead, XmlWrite
{$ENDIF};
const
sCONFIG_FILE_NAME = 'wst_config.xml';
sAPPLICATION = 'Application';
sWST_CONFIG_PATH = 'WST_Configuration';
var
ConfigurationObjectInstance : TWstConfigurationObject = nil;
{$IFNDEF FPC}
function GetAppConfigDir(const AGlobal : Boolean) : string;
begin
Result := ExtractFilePath(ParamStr(0));
end;
function GetAppConfigFile(const AGlobal : Boolean) : string;
begin
Result := ChangeFileExt(ParamStr(0),'.xml');
end;
{$ENDIF}
function wst_GetConfigFileName():string;
begin
Result := ChangeFileExt(GetAppConfigFile(True),'.' + sCONFIG_FILE_NAME);
end;
procedure wst_LoadConfigObject(AConfig: TWstConfigurationObject; AStream : TStream);overload;
var
frmt : IFormatterBase;
locPrmName : string;
begin
frmt := TSOAPBaseFormatter.Create();
frmt.LoadFromStream(AStream);
frmt.SetSerializationStyle(ssNodeSerialization);
locPrmName := sWST_CONFIG_PATH;
frmt.Get(TypeInfo(TWstConfigurationObject),locPrmName,AConfig);
end;
procedure wst_LoadConfigObject(AConfig : TWstConfigurationObject; const AFileName : string);overload;
var
locStream : TMemoryStream;
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt('File not found : "%s".',[AFileName]);
locStream := TMemoryStream.Create();
try
locStream.LoadFromFile(AFileName);
locStream.Position := 0;
wst_LoadConfigObject(AConfig,locStream);
finally
FreeAndNil(locStream);
end;
end;
procedure wst_CreateDefaultFile(ADest : TStream; AConfigObj : TWstConfigurationObject);overload;
var
locObj : TWstConfigurationObject;
c, i : Integer;
servReg : IServerServiceRegistry;
frmt : IFormatterBase;
createdHere : Boolean;
begin
if ( AConfigObj <> nil ) then
locObj := AConfigObj
else
locObj := TWstConfigurationObject.Create();
try
createdHere := ( AConfigObj = nil );
servReg := GetServerServiceRegistry();
c := servReg.GetCount();
locObj.Services.SetLength(0);
if ( c > 0 ) then begin
locObj.Services.SetLength(c);
for i := 0 to Pred(c) do begin
locObj.Services[i].Name := servReg.GetName(i);
end;
end;
frmt := TSOAPBaseFormatter.Create();
frmt.SetSerializationStyle(ssNodeSerialization);
frmt.BeginObject(sAPPLICATION,TypeInfo(TWstConfigurationObject));
frmt.Put(sWST_CONFIG_PATH,TypeInfo(TWstConfigurationObject),locObj);
frmt.EndScope();
frmt.SaveToStream(ADest);
finally
if createdHere then
FreeAndNil(locObj);
end;
end;
procedure wst_CreateDefaultFile(const AFileName : string; AConfigObj : TWstConfigurationObject);overload;
var
locStream : TMemoryStream;
begin
locStream := TMemoryStream.Create();
try
wst_CreateDefaultFile(locStream,AConfigObj);
locStream.SaveToFile(AFileName);
finally
FreeAndNil(locStream);
end;
end;
function wst_GetConfigObject() : TWstConfigurationObject;
var
locFileName : string;
begin
if ( ConfigurationObjectInstance = nil ) then begin
ConfigurationObjectInstance := TWstConfigurationObject.Create();
locFileName := wst_GetConfigFileName();
if FileExists(locFileName) then
wst_LoadConfigObject(ConfigurationObjectInstance,locFileName)
else
wst_CreateDefaultFile(locFileName,ConfigurationObjectInstance);
end;
Result := ConfigurationObjectInstance;
end;
function wst_GetServiceConfig(const AName : string) : TwstConfigService ;
var
i, c : Integer;
servs : TwstConfigServiceArray;
begin
Result := nil;
servs := wst_GetConfigObject().Services;
c := servs.Length;
for i := 0 to Pred(c) do begin
if AnsiSameText(AName,servs[i].Name) then begin
Result := servs[i];
Break;
end;
end;
end;
function wst_GetServiceConfigText(const AName : string) : string ;
var
s : TwstConfigService;
begin
s := wst_GetServiceConfig(AName);
if ( s <> nil ) then
Result := s.GetConfigText()
else
Result := '';
end;
{ TwstConfigServiceArray }
function TwstConfigServiceArray.GetItem(AIndex: Integer): TwstConfigService;
begin
Result := Inherited GetItem(AIndex) As TwstConfigService;
end;
class function TwstConfigServiceArray.GetItemClass() : TBaseRemotableClass;
begin
Result := TwstConfigService;
end;
{ TWstConfigurationObject }
constructor TWstConfigurationObject.Create;
begin
inherited;
FServices := TwstConfigServiceArray.Create();
end;
destructor TWstConfigurationObject.Destroy;
begin
FreeAndNil(FServices);
inherited;
end;
{ TwstConfigService }
function TwstConfigService.GetConfigText() : string;
begin
Result := Format('PoolMin=%d;PoolMax=%d;Pooled=',[PoolMin,PoolMax]);
if Pooled then
Result := Result + 'True'
else
Result := Result + 'False';
end;
initialization
GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TwstConfigService),'Service');
GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TwstConfigServiceArray),'Services');
GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TWstConfigurationObject),'WST_Configuration');
TwstConfigService.RegisterAttributeProperty('Name');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TwstConfigServiceArray)].RegisterExternalPropertyName('Item','service');
finalization
if ( ConfigurationObjectInstance <> nil ) and
( GetServerServiceRegistry.GetCount() <> ConfigurationObjectInstance.Services.Length )
then begin
wst_CreateDefaultFile(wst_GetConfigFileName(),nil);
end;
FreeAndNil(ConfigurationObjectInstance);
end.

13
wst/tags/0.5/delphi_init_com.pas Normal file
View File

@ -0,0 +1,13 @@
unit delphi_init_com;
interface
uses ActiveX;
implementation
initialization
CoInitialize(nil);
finalization
CoUninitialize();
end.

BIN
wst/tags/0.5/doc/WebServiceToolKit.odt Normal file
View File

Binary file not shown.

3929
wst/tags/0.5/doc/WebServiceToolKit.rtf Normal file
View File

File diff suppressed because it is too large Load Diff

207
wst/tags/0.5/ics_http_protocol.pas Normal file
View File

@ -0,0 +1,207 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit ics_http_protocol;
//{$DEFINE WST_DBG}
interface
uses
Classes, SysUtils, {$IFDEF WST_DBG}Dialogs,{$ENDIF}
service_intf, imp_utils, base_service_intf,
HttpProt;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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
FFormat : string;
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;
property Format : string read FFormat write FFormat;
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);
TMemoryStream(AResponse).SaveToFile('request.log');
ARequest.Position := i;
{$ENDIF WST_DBG}
FConnection.SendStream := ARequest;
FConnection.RcvdStream := AResponse;
FConnection.Post();
{$IFDEF WST_DBG}
TMemoryStream(AResponse).SaveToFile('request.log');
i := AResponse.Position;
SetLength(s,AResponse.Size);
AResponse.Read(s[1],AResponse.Size);
TMemoryStream(AResponse).SaveToFile('response.log');
if IsConsole then
WriteLn(s)
else
ShowMessage(s);
{$ENDIF WST_DBG}
end;
procedure ICS_RegisterHTTP_Transport();
begin
GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory);
end;
end.

227
wst/tags/0.5/ics_tcp_protocol.pas Normal file
View File

@ -0,0 +1,227 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit ics_tcp_protocol;
interface
uses
Classes, SysUtils,
service_intf, imp_utils, base_service_intf,
WSocket;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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;
FFormat : string;
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;
property Format : string read FFormat write FFormat;
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 := {$IFDEF FPC}@{$ENDIF}DataAvailable;
FConnection.OnBgException := {$IFDEF FPC}@{$ENDIF}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);
wrtr.WriteStr(Self.Format);
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.

418
wst/tags/0.5/ide/lazarus/test/test_import.lpi Normal file
View File

@ -0,0 +1,418 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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="40">
<Unit0>
<Filename Value="test_import.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_import"/>
<CursorPos X="1" Y="17"/>
<TopLine Value="1"/>
<UsageCount Value="73"/>
</Unit0>
<Unit1>
<Filename Value="..\wstimportdlg.pas"/>
<ComponentName Value="formImport"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="..\wstimportdlg.lrs"/>
<UnitName Value="wstimportdlg"/>
<CursorPos X="1" Y="5"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="73"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\lcl\interfaces\win32\interfaces.pp"/>
<UnitName Value="Interfaces"/>
<CursorPos X="41" Y="11"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\ws_helper\command_line_parser.pas"/>
<UnitName Value="command_line_parser"/>
<CursorPos X="1" Y="31"/>
<TopLine Value="16"/>
<UsageCount Value="7"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\ws_helper\pscanner.pp"/>
<UnitName Value="PScanner"/>
<CursorPos X="12" Y="76"/>
<TopLine Value="323"/>
<UsageCount Value="14"/>
</Unit4>
<Unit5>
<Filename Value="..\..\..\ws_helper\pascal_parser_intf.pas"/>
<UnitName Value="pascal_parser_intf"/>
<CursorPos X="1" Y="390"/>
<TopLine Value="375"/>
<EditorIndex Value="8"/>
<UsageCount Value="35"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\ws_helper\wsdl2pas_imp.pas"/>
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="18" Y="747"/>
<TopLine Value="736"/>
<EditorIndex Value="7"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\ws_helper\logger_intf.pas"/>
<UnitName Value="logger_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\ws_helper\source_utils.pas"/>
<UnitName Value="source_utils"/>
<CursorPos X="14" Y="311"/>
<TopLine Value="291"/>
<EditorIndex Value="9"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\ws_helper\generator.pas"/>
<UnitName Value="generator"/>
<CursorPos X="31" Y="1645"/>
<TopLine Value="1633"/>
<EditorIndex Value="6"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\ws_helper\metadata_generator.pas"/>
<UnitName Value="metadata_generator"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\binary_streamer.pas"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="23" Y="21"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\ws_helper\wst_resources_utils.pas"/>
<UnitName Value="wst_resources_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="2" Y="13"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="..\..\..\wst_rtti_filter\dom_cursors.pas"/>
<UnitName Value="dom_cursors"/>
<CursorPos X="1" Y="227"/>
<TopLine Value="205"/>
<UsageCount Value="16"/>
</Unit15>
<Unit16>
<Filename Value="..\..\..\ws_helper\parserutils.pas"/>
<UnitName Value="parserutils"/>
<CursorPos X="9" Y="91"/>
<TopLine Value="39"/>
<UsageCount Value="11"/>
</Unit16>
<Unit17>
<Filename Value="..\..\..\wst_rtti_filter\rtti_filters.pas"/>
<UnitName Value="rtti_filters"/>
<CursorPos X="1" Y="565"/>
<TopLine Value="543"/>
<UsageCount Value="11"/>
</Unit17>
<Unit18>
<Filename Value="..\..\..\wst.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit18>
<Unit19>
<Filename Value="..\..\..\wst_delphi.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit19>
<Unit20>
<Filename Value="..\..\..\ws_helper\pastree.pp"/>
<UnitName Value="PasTree"/>
<CursorPos X="3" Y="663"/>
<TopLine Value="659"/>
<UsageCount Value="16"/>
</Unit20>
<Unit21>
<Filename Value="uform2.pas"/>
<ComponentName Value="Form2"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="uform2.lrs"/>
<UnitName Value="uform2"/>
<CursorPos X="45" Y="28"/>
<TopLine Value="19"/>
<EditorIndex Value="3"/>
<UsageCount Value="73"/>
<Loaded Value="True"/>
</Unit21>
<Unit22>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\inc\heaptrc.pp"/>
<UnitName Value="heaptrc"/>
<CursorPos X="29" Y="46"/>
<TopLine Value="34"/>
<UsageCount Value="7"/>
</Unit22>
<Unit23>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\inc\objpash.inc"/>
<CursorPos X="22" Y="149"/>
<TopLine Value="135"/>
<UsageCount Value="7"/>
</Unit23>
<Unit24>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\packages\fcl-base\src\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="15" Y="125"/>
<TopLine Value="111"/>
<UsageCount Value="7"/>
</Unit24>
<Unit25>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysutils.inc"/>
<CursorPos X="1" Y="109"/>
<TopLine Value="95"/>
<UsageCount Value="7"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\inc\objpas.inc"/>
<CursorPos X="66" Y="85"/>
<TopLine Value="58"/>
<UsageCount Value="11"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\inc\wstrings.inc"/>
<CursorPos X="1" Y="188"/>
<TopLine Value="174"/>
<UsageCount Value="7"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="1" Y="388"/>
<TopLine Value="374"/>
<UsageCount Value="7"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\inc\heap.inc"/>
<CursorPos X="1" Y="607"/>
<TopLine Value="595"/>
<UsageCount Value="11"/>
</Unit29>
<Unit30>
<Filename Value="..\..\..\ws_helper\pparser.pp"/>
<UnitName Value="PParser"/>
<CursorPos X="22" Y="49"/>
<TopLine Value="32"/>
<UsageCount Value="15"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\..\..\..\..\lazarus2204\lcl\include\screen.inc"/>
<CursorPos X="1" Y="471"/>
<TopLine Value="457"/>
<UsageCount Value="7"/>
</Unit31>
<Unit32>
<Filename Value="..\wst_register.pas"/>
<UnitName Value="wst_register"/>
<CursorPos X="14" Y="6"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215XX\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<CursorPos X="15" Y="36"/>
<TopLine Value="26"/>
<UsageCount Value="8"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\inc\heaptrc.pp"/>
<UnitName Value="heaptrc"/>
<CursorPos X="8" Y="115"/>
<TopLine Value="109"/>
<UsageCount Value="8"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\..\..\..\lazarus2204\lcl\interfaces\win32\win32memostrings.inc"/>
<CursorPos X="1" Y="74"/>
<TopLine Value="60"/>
<UsageCount Value="8"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="14" Y="242"/>
<TopLine Value="220"/>
<UsageCount Value="8"/>
</Unit36>
<Unit37>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="13" Y="233"/>
<TopLine Value="196"/>
<UsageCount Value="8"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\..\..\..\..\lazarus_23_215XX\lcl\include\screen.inc"/>
<CursorPos X="1" Y="480"/>
<TopLine Value="465"/>
<UsageCount Value="10"/>
</Unit38>
<Unit39>
<Filename Value="..\..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit39>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="..\..\..\wst_rtti_filter\cursor_intf.pas"/>
<Caret Line="99" Column="1" TopLine="77"/>
</Position1>
<Position2>
<Filename Value="..\..\..\ws_helper\wst_resources_utils.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="..\wstimportdlg.pas"/>
<Caret Line="256" Column="22" TopLine="233"/>
</Position3>
<Position4>
<Filename Value="..\wstimportdlg.pas"/>
<Caret Line="12" Column="31" TopLine="54"/>
</Position4>
<Position5>
<Filename Value="..\..\..\ws_helper\wst_resources_utils.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position5>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="..\..\..\"/>
<OtherUnitFiles Value="..\;..\..\..\;..\..\..\ws_helper\;..\..\..\wst_rtti_filter\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Generate Value="Faster"/>
<Optimizations>
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="2">
<Item1>
<Source Value="..\..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="1359"/>
</Item1>
<Item2>
<Source Value="..\..\..\ws_helper\source_utils.pas"/>
<Line Value="207"/>
</Item2>
</BreakPoints>
<Watches Count="3">
<Item1>
<Expression Value="FName"/>
</Item1>
<Item2>
<Expression Value="FRefCount"/>
</Item2>
<Item3>
<Expression Value="Self"/>
</Item3>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

18
wst/tags/0.5/ide/lazarus/test/test_import.lpr Normal file
View File

@ -0,0 +1,18 @@
program test_import;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, wstimportdlg, uform2;
begin
Application.Initialize;
Application.CreateForm(TForm2, Form2);
Application.Run;
end.

22
wst/tags/0.5/ide/lazarus/test/uform2.lfm Normal file
View File

@ -0,0 +1,22 @@
object Form2: TForm2
Left = 322
Height = 300
Top = 275
Width = 400
HorzScrollBar.Page = 399
VertScrollBar.Page = 299
ActiveControl = Button1
Caption = 'Form2'
ClientHeight = 300
ClientWidth = 400
object Button1: TButton
Left = 190
Height = 25
Top = 65
Width = 75
BorderSpacing.InnerBorder = 4
Caption = 'Button1'
OnClick = Button1Click
TabOrder = 0
end
end

8
wst/tags/0.5/ide/lazarus/test/uform2.lrs Normal file
View File

@ -0,0 +1,8 @@
LazarusResources.Add('TForm2','FORMDATA',[
'TPF0'#6'TForm2'#5'Form2'#4'Left'#3'B'#1#6'Height'#3','#1#3'Top'#3#19#1#5'Wid'
+'th'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#13
+'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form2'#12'ClientHeight'#3','#1#11
+'ClientWidth'#3#144#1#0#7'TButton'#7'Button1'#4'Left'#3#190#0#6'Height'#2#25
+#3'Top'#2'A'#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#7
+'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0
]);

48
wst/tags/0.5/ide/lazarus/test/uform2.pas Normal file
View File

@ -0,0 +1,48 @@
unit uform2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons;
type
{ TForm2 }
TForm2 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form2: TForm2;
implementation
uses wstimportdlg;//, HeapTrc;
{ TForm2 }
procedure TForm2.Button1Click(Sender: TObject);
var
f : TformImport;
begin
f := TformImport.Create(nil);
try
f.ShowModal();
finally
f.Release();
end;
end;
initialization
//SetHeapTraceOutput('heapTrace.txt');
{$I uform2.lrs}
end.

96
wst/tags/0.5/ide/lazarus/wst_design.lpk Normal file
View File

@ -0,0 +1,96 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<PathDelim Value="\"/>
<Name Value="wst_design"/>
<Author Value="Inoussa OUEDRAOGO"/>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\type_lib_edtr\"/>
<OtherUnitFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\type_lib_edtr\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Web Services Toolkit Lazarus IDE design time package"/>
<Version Minor="1"/>
<Files Count="10">
<Item1>
<Filename Value="wstimportdlg.lfm"/>
<Type Value="LFM"/>
</Item1>
<Item2>
<Filename Value="wstimportdlg.lrs"/>
<Type Value="LRS"/>
</Item2>
<Item3>
<Filename Value="wstimportdlg.pas"/>
<UnitName Value="wstimportdlg"/>
</Item3>
<Item4>
<Filename Value="wst_register.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="wst_register"/>
</Item4>
<Item5>
<Filename Value="..\..\type_lib_edtr\uwsttypelibraryedit.lfm"/>
<Type Value="LFM"/>
</Item5>
<Item6>
<Filename Value="..\..\type_lib_edtr\uwsttypelibraryedit.lrs"/>
<Type Value="LRS"/>
</Item6>
<Item7>
<Filename Value="..\..\type_lib_edtr\uwsttypelibraryedit.pas"/>
<UnitName Value="uwsttypelibraryedit"/>
</Item7>
<Item8>
<Filename Value="..\..\type_lib_edtr\uabout.lfm"/>
<Type Value="LFM"/>
</Item8>
<Item9>
<Filename Value="..\..\type_lib_edtr\uabout.lrs"/>
<Type Value="LRS"/>
</Item9>
<Item10>
<Filename Value="..\..\type_lib_edtr\uabout.pas"/>
<UnitName Value="uabout"/>
</Item10>
</Files>
<Type Value="DesignTime"/>
<RequiredPkgs Count="4">
<Item1>
<PackageName Value="SynEdit"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="IDEIntf"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item4>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)\"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

21
wst/tags/0.5/ide/lazarus/wst_design.pas Normal file
View File

@ -0,0 +1,21 @@
{ Ce fichier a �t� automatiquement cr�� par Lazarus. Ne pas l'�diter !
Cette source est seulement employ�e pour compiler et installer le paquet.
}
unit wst_design;
interface
uses
wstimportdlg, wst_register, uwsttypelibraryedit, uabout, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit ('wst_register', @wst_register.Register );
end;
initialization
RegisterPackage ('wst_design', @Register );
end.

58
wst/tags/0.5/ide/lazarus/wst_register.pas Normal file
View File

@ -0,0 +1,58 @@
unit wst_register;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
procedure Register();
implementation
uses MenuIntf, LazIDEIntf,
wstimportdlg, uwsttypelibraryedit;
procedure ShowImportDialog(Sender: TObject);
var
f : TformImport;
begin
f := TformImport.Create(nil);
try
if ( LazarusIDE.ActiveProject <> nil ) and
( LazarusIDE.ActiveProject.MainFile <> nil )
then begin
f.edtOutputDir.Text := ExtractFileDir(LazarusIDE.ActiveProject.MainFile.Filename);
end;
f.ShowModal();
finally
f.Release();
end;
end;
procedure ShowTypeLibraryDialog(Sender: TObject);
var
f : TfWstTypeLibraryEdit;
begin
f := TfWstTypeLibraryEdit.Create(nil);
try
f.ShowModal();
finally
f.Release();
end;
end;
var
itmWstSection : TIDEMenuSection;
procedure Register();
begin
itmWstSection := RegisterIDESubMenu(mnuProject,'itmWstSection','Web Services Toolkit',nil,nil);
RegisterIDEMenuCommand(itmWstSection,'itmWstImportWsdlFile','Import WSDL File ...',nil,@ShowImportDialog);
RegisterIDEMenuCommand(itmWstSection,'itmWstImportWsdlFile','Type Library Editor ...',nil,@ShowTypeLibraryDialog);
end;
end.

233
wst/tags/0.5/ide/lazarus/wstimportdlg.lfm Normal file
View File

@ -0,0 +1,233 @@
object formImport: TformImport
Left = 431
Height = 538
Top = 153
Width = 526
HorzScrollBar.Page = 525
VertScrollBar.Page = 537
ActiveControl = Button1
BorderStyle = bsSizeToolWin
Caption = 'WSDL Importer'
ClientHeight = 538
ClientWidth = 526
object Panel2: TPanel
Height = 490
Width = 526
Align = alClient
ClientHeight = 490
ClientWidth = 526
TabOrder = 1
object GroupBox1: TGroupBox
Left = 8
Height = 168
Top = 8
Width = 506
Anchors = [akTop, akLeft, akRight]
ClientHeight = 150
ClientWidth = 502
TabOrder = 0
object Label1: TLabel
Left = 9
Height = 14
Top = 4
Width = 186
Caption = 'Web Services Description File ( WSDL )'
ParentColor = False
end
object Label2: TLabel
Left = 9
Height = 14
Top = 69
Width = 81
Caption = 'Output directory'
ParentColor = False
end
object edtInputFile: TEdit
Left = 9
Height = 23
Top = 31
Width = 404
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object Button2: TButton
Left = 431
Height = 25
Top = 31
Width = 40
Action = actOpenFile
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 1
end
object edtOutputDir: TEdit
Left = 9
Height = 23
Top = 88
Width = 404
Anchors = [akTop, akLeft, akRight]
TabOrder = 2
end
object Button3: TButton
Left = 431
Height = 25
Top = 88
Width = 40
Action = actOpenDir
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 3
end
object edtAddToProject: TCheckBox
Left = 9
Height = 13
Top = 128
Width = 176
Caption = 'Add the generated files to project'
TabOrder = 4
end
end
object GroupBox2: TGroupBox
Left = 8
Height = 162
Top = 320
Width = 506
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = ' Messages '
ClientHeight = 144
ClientWidth = 502
TabOrder = 2
object mmoLog: TMemo
Height = 144
Width = 502
Align = alClient
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
end
end
object GroupBox3: TGroupBox
Left = 8
Height = 120
Top = 184
Width = 506
Anchors = [akTop, akLeft, akRight]
Caption = ' Options '
ClientHeight = 102
ClientWidth = 502
TabOrder = 1
object edtOptionIntf: TCheckBox
Left = 9
Height = 13
Top = 8
Width = 78
Caption = 'Interface file'
Checked = True
OnClick = edtOptionIntfClick
State = cbChecked
TabOrder = 0
end
object edtOptionProxy: TCheckBox
Left = 9
Height = 13
Top = 56
Width = 62
Caption = 'Proxy file'
Checked = True
State = cbChecked
TabOrder = 2
end
object edtOptionBinder: TCheckBox
Left = 294
Height = 13
Top = 8
Width = 105
Caption = 'Service Binder file'
TabOrder = 3
end
object edtOptionImp: TCheckBox
Left = 294
Height = 13
Top = 56
Width = 152
Caption = 'Implementation Skeleton file'
TabOrder = 4
end
object edtOptionIntfALL: TCheckBox
Left = 30
Height = 13
Top = 32
Width = 88
Caption = 'Parse all types'
OnClick = edtOptionIntfALLClick
TabOrder = 1
end
end
end
object Panel1: TPanel
Height = 48
Top = 490
Width = 526
Align = alBottom
ClientHeight = 48
ClientWidth = 526
TabOrder = 0
object Button1: TButton
Left = 351
Height = 25
Top = 8
Width = 75
Action = actOK
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Default = True
TabOrder = 0
end
object Button4: TButton
Left = 439
Height = 25
Top = 8
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object AL: TActionList
left = 104
top = 328
object actOK: TAction
Caption = 'OK'
DisableIfNoHandler = True
OnExecute = actOKExecute
OnUpdate = actOKUpdate
end
object actOpenFile: TAction
Caption = '...'
DisableIfNoHandler = True
OnExecute = actOpenFileExecute
end
object actOpenDir: TAction
Caption = '...'
DisableIfNoHandler = True
OnExecute = actOpenDirExecute
end
end
object OD: TOpenDialog
Title = 'Ouvrir un fichier existant'
Filter = 'WSDL Files ( *.wsdl )|*.wsdl'
FilterIndex = 0
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 272
top = 32
end
object SDD: TSelectDirectoryDialog
Title = 'Choisir un r�pertoire'
FilterIndex = 0
left = 224
top = 176
end
end

65
wst/tags/0.5/ide/lazarus/wstimportdlg.lrs Normal file
View File

@ -0,0 +1,65 @@
{ Ceci est un fichier ressource g�n�r� automatiquement par Lazarus }
LazarusResources.Add('TformImport','FORMDATA',[
'TPF0'#11'TformImport'#10'formImport'#4'Left'#3#175#1#6'Height'#3#26#2#3'Top'
+#3#153#0#5'Width'#3#14#2#18'HorzScrollBar.Page'#3#13#2#18'VertScrollBar.Page'
+#3#25#2#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7
+'Caption'#6#13'WSDL Importer'#12'ClientHeight'#3#26#2#11'ClientWidth'#3#14#2
+#0#6'TPanel'#6'Panel2'#6'Height'#3#234#1#5'Width'#3#14#2#5'Align'#7#8'alClie'
+'nt'#12'ClientHeight'#3#234#1#11'ClientWidth'#3#14#2#8'TabOrder'#2#1#0#9'TGr'
+'oupBox'#9'GroupBox1'#4'Left'#2#8#6'Height'#3#168#0#3'Top'#2#8#5'Width'#3#250
+#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'ClientHeight'#3#150#0#11
+'ClientWidth'#3#246#1#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#9#6'He'
+'ight'#2#14#3'Top'#2#4#5'Width'#3#186#0#7'Caption'#6'&Web Services Descripti'
+'on File ( WSDL )'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#9#6'H'
+'eight'#2#14#3'Top'#2'E'#5'Width'#2'Q'#7'Caption'#6#16'Output directory'#11
+'ParentColor'#8#0#0#5'TEdit'#12'edtInputFile'#4'Left'#2#9#6'Height'#2#23#3'T'
+'op'#2#31#5'Width'#3#148#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'T'
+'abOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3#175#1#6'Height'#2#25#3'Top'
+#2#31#5'Width'#2'('#6'Action'#7#11'actOpenFile'#7'Anchors'#11#5'akTop'#7'akR'
+'ight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#1#0#0#5'TEdit'#12'e'
+'dtOutputDir'#4'Left'#2#9#6'Height'#2#23#3'Top'#2'X'#5'Width'#3#148#1#7'Anch'
+'ors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#0#0#7'TButton'#7'Bu'
+'tton3'#4'Left'#3#175#1#6'Height'#2#25#3'Top'#2'X'#5'Width'#2'('#6'Action'#7
+#10'actOpenDir'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBo'
+'rder'#2#4#8'TabOrder'#2#3#0#0#9'TCheckBox'#15'edtAddToProject'#4'Left'#2#9#6
+'Height'#2#13#3'Top'#3#128#0#5'Width'#3#176#0#7'Caption'#6'"Add the generate'
+'d files to project'#8'TabOrder'#2#4#0#0#0#9'TGroupBox'#9'GroupBox2'#4'Left'
+#2#8#6'Height'#3#162#0#3'Top'#3'@'#1#5'Width'#3#250#1#7'Anchors'#11#5'akTop'
+#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#12' Messages '#12'ClientH'
+'eight'#3#144#0#11'ClientWidth'#3#246#1#8'TabOrder'#2#2#0#5'TMemo'#6'mmoLog'
+#6'Height'#3#144#0#5'Width'#3#246#1#5'Align'#7#8'alClient'#8'ReadOnly'#9#10
+'ScrollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#9'TGroupBox'#9'GroupBox3'#4'L'
+'eft'#2#8#6'Height'#2'x'#3'Top'#3#184#0#5'Width'#3#250#1#7'Anchors'#11#5'akT'
+'op'#6'akLeft'#7'akRight'#0#7'Caption'#6#11' Options '#12'ClientHeight'#2
+'f'#11'ClientWidth'#3#246#1#8'TabOrder'#2#1#0#9'TCheckBox'#13'edtOptionIntf'
+#4'Left'#2#9#6'Height'#2#13#3'Top'#2#8#5'Width'#2'N'#7'Caption'#6#14'Interfa'
+'ce file'#7'Checked'#9#7'OnClick'#7#18'edtOptionIntfClick'#5'State'#7#9'cbCh'
+'ecked'#8'TabOrder'#2#0#0#0#9'TCheckBox'#14'edtOptionProxy'#4'Left'#2#9#6'He'
+'ight'#2#13#3'Top'#2'8'#5'Width'#2'>'#7'Caption'#6#10'Proxy file'#7'Checked'
+#9#5'State'#7#9'cbChecked'#8'TabOrder'#2#2#0#0#9'TCheckBox'#15'edtOptionBind'
+'er'#4'Left'#3'&'#1#6'Height'#2#13#3'Top'#2#8#5'Width'#2'i'#7'Caption'#6#19
+'Service Binder file'#8'TabOrder'#2#3#0#0#9'TCheckBox'#12'edtOptionImp'#4'Le'
+'ft'#3'&'#1#6'Height'#2#13#3'Top'#2'8'#5'Width'#3#152#0#7'Caption'#6#28'Impl'
+'ementation Skeleton file'#8'TabOrder'#2#4#0#0#9'TCheckBox'#16'edtOptionIntf'
+'ALL'#4'Left'#2#30#6'Height'#2#13#3'Top'#2' '#5'Width'#2'X'#7'Caption'#6#15
+'Parse all types'#7'OnClick'#7#21'edtOptionIntfALLClick'#8'TabOrder'#2#1#0#0
+#0#0#6'TPanel'#6'Panel1'#6'Height'#2'0'#3'Top'#3#234#1#5'Width'#3#14#2#5'Ali'
+'gn'#7#8'alBottom'#12'ClientHeight'#2'0'#11'ClientWidth'#3#14#2#8'TabOrder'#2
+#0#0#7'TButton'#7'Button1'#4'Left'#3'_'#1#6'Height'#2#25#3'Top'#2#8#5'Width'
+#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpac'
+'ing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#0#0#0#7'TButton'#7'Button4'
+#4'Left'#3#183#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'K'#7'Anchors'#11#5'akT'
+'op'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6
+#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#11'TActionList'#2'AL'#4
+'left'#2'h'#3'top'#3'H'#1#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'Disabl'
+'eIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdat'
+'e'#0#0#7'TAction'#11'actOpenFile'#7'Caption'#6#3'...'#18'DisableIfNoHandler'
+#9#9'OnExecute'#7#18'actOpenFileExecute'#0#0#7'TAction'#10'actOpenDir'#7'Cap'
+'tion'#6#3'...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actOpenDirExecute'
+#0#0#0#11'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un fichier existant'#6'Fil'
+'ter'#6#28'WSDL Files ( *.wsdl )|*.wsdl'#11'FilterIndex'#2#0#7'Options'#11#15
+'ofFileMustExist'#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#16#1#3'top'
+#2' '#0#0#22'TSelectDirectoryDialog'#3'SDD'#5'Title'#6#21'Choisir un r'#233
+'pertoire'#11'FilterIndex'#2#0#4'left'#3#224#0#3'top'#3#176#0#0#0#0
]);

308
wst/tags/0.5/ide/lazarus/wstimportdlg.pas Normal file
View File

@ -0,0 +1,308 @@
unit wstimportdlg;
{$mode objfpc}{$H+}
{$DEFINE WST_IDE}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Buttons, ActnList, logger_intf;
type
TGenOption = (
goInterface, goInterfaceALL,
goProxy, goImp, goBinder
);
TGenOptions = set of TGenOption;
TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object;
{ TformImport }
TformImport = class(TForm)
actOpenDir: TAction;
actOpenFile: TAction;
actOK: TAction;
AL: TActionList;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
edtAddToProject : TCheckBox;
edtOptionIntfALL: TCheckBox;
edtOptionIntf: TCheckBox;
edtOptionProxy: TCheckBox;
edtOptionBinder: TCheckBox;
edtOptionImp: TCheckBox;
edtInputFile: TEdit;
edtOutputDir: TEdit;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Label1: TLabel;
Label2: TLabel;
mmoLog: TMemo;
OD: TOpenDialog;
Panel1: TPanel;
Panel2: TPanel;
SDD: TSelectDirectoryDialog;
procedure actOKExecute(Sender: TObject);
procedure actOKUpdate(Sender: TObject);
procedure actOpenDirExecute(Sender: TObject);
procedure actOpenFileExecute(Sender: TObject);
procedure edtOptionIntfALLClick(Sender: TObject);
procedure edtOptionIntfClick(Sender: TObject);
private
FStatusMessageTag : Integer;
procedure ShowStatusMessage(const AMsgType : TMessageType;const AMsg : string);
public
function GetOptions() : TGenOptions;
end;
var
formImport: TformImport;
implementation
uses DOM, XMLRead, pastree, pascal_parser_intf, wsdl2pas_imp, source_utils,
generator, metadata_generator, binary_streamer, wst_resources_utils
{$IFDEF WST_IDE},LazIDEIntf{$ENDIF};
type
TSourceType = goInterface .. goBinder;
TSourceTypes = set of TSourceType;
function ParseWsdlFile(
const AFileName : string;
const ANotifier : TOnParserMessage
):TwstPasTreeContainer;
var
locDoc : TXMLDocument;
prsr : TWsdlParser;
symName : string;
begin
Result := nil;
if FileExists(AFileName) then begin
symName := ChangeFileExt(ExtractFileName(AFileName),'');
if ( symName[Length(symName)] = '.' ) then begin
Delete(symName,Length(symName),1);
end;
prsr := nil;
ReadXMLFile(locDoc,AFileName);
try
Result := TwstPasTreeContainer.Create();
try
prsr := TWsdlParser.Create(locDoc,Result);
prsr.OnMessage := ANotifier;
prsr.Parse(pmAllTypes,symName);
except
FreeAndNil(Result);
raise;
end;
finally
FreeAndNil(prsr);
FreeAndNil(locDoc);
end;
end;
end;
type TOutputType = ( otMemory, otFileSystem );
function GenerateSource(
ASymbolTable : TwstPasTreeContainer;
AOptions : TSourceTypes;
const AOutputType : TOutputType;
const AOutPath : string;
const ANotifier : TOnParserMessage
) : ISourceManager;
procedure Notify(const AMsg : string);
begin
if Assigned(ANotifier) then begin
ANotifier(mtInfo, AMsg);
end;
end;
var
mtdaFS: TMemoryStream;
g : TBaseGenerator;
mg : TMetadataGenerator;
rsrcStrm : TMemoryStream;
begin
Result := CreateSourceManager();
rsrcStrm := nil;
mtdaFS := nil;
mg := nil;
g := Nil;
try
if ( ( [goInterface,goInterfaceALL] * AOptions ) <> [] ) then begin
Notify('Interface file generation...');
g := TInftGenerator.Create(ASymbolTable,Result);
g.Execute();
FreeAndNil(g);
end;
if ( goProxy in AOptions ) then begin
Notify('Proxy file generation...');
g := TProxyGenerator.Create(ASymbolTable,Result);
g.Execute();
FreeAndNil(g);
end;
if ( goBinder in AOptions ) then begin
Notify('Binder file generation...');
g := TBinderGenerator.Create(ASymbolTable,Result);
g.Execute();
FreeAndNil(g);
end;
if ( goImp in AOptions ) then begin
Notify('Implementation file generation...');
g := TImplementationGenerator.Create(ASymbolTable,Result);
g.Execute();
FreeAndNil(g);
end;
if ( AOutputType = otFileSystem ) and ( [goBinder,goProxy]*AOptions <> [] ) then begin
Notify('Metadata file generation...');
mtdaFS := TMemoryStream.Create();
mg := TMetadataGenerator.Create(ASymbolTable,CreateBinaryWriter(mtdaFS));
mg.Execute();
mtdaFS.SaveToFile(AOutPath + Format('%s.%s',[ASymbolTable.CurrentModule.Name,sWST_META]));
rsrcStrm := TMemoryStream.Create();
mtdaFS.Position := 0;
BinToWstRessource(UpperCase(ASymbolTable.CurrentModule.Name),mtdaFS,rsrcStrm);
rsrcStrm.SaveToFile(AOutPath + Format('%s.%s',[ASymbolTable.CurrentModule.Name,sWST_EXTENSION]));
end;
if ( AOutputType = otFileSystem ) then begin
Result.SaveToFile(AOutPath);
end;
finally
rsrcStrm.Free();
mg.Free();;
mtdaFS.Free();;
g.Free();
end;
end;
{ TformImport }
procedure TformImport.actOpenFileExecute(Sender: TObject);
begin
if OD.Execute() then begin
edtInputFile.Text := OD.FileName;
end;
end;
procedure TformImport.edtOptionIntfALLClick(Sender: TObject);
begin
if edtOptionIntfALL.Checked and ( not edtOptionIntf.Checked ) then
edtOptionIntf.Checked := True;
end;
procedure TformImport.edtOptionIntfClick(Sender: TObject);
begin
if ( not edtOptionIntf.Checked ) and edtOptionIntfALL.Checked then
edtOptionIntfALL.Checked := False;
end;
procedure TformImport.ShowStatusMessage(const AMsgType: TMessageType;const AMsg: string);
begin
mmoLog.Lines.Add(Format('%s : %s',[MessageTypeNames[AMsgType],AMsg]));
Inc(FStatusMessageTag);
if ( (FStatusMessageTag) > 23 ) then begin
FStatusMessageTag := 0;
Application.ProcessMessages();
end;
end;
function TformImport.GetOptions(): TGenOptions;
begin
Result := [];
if edtOptionIntf.Checked then begin
Result := Result + [goInterface];
if edtOptionIntfALL.Checked then begin
Result := Result + [goInterfaceALL];
end;
end;
if edtOptionProxy.Checked then
Include(Result,goProxy);
if edtOptionBinder.Checked then
Include(Result,goBinder);
if edtOptionImp.Checked then
Include(Result,goImp);
end;
procedure TformImport.actOpenDirExecute(Sender: TObject);
begin
if SDD.Execute() then begin
if not DirectoryExists(SDD.FileName) then
ForceDirectories(SDD.FileName);
edtOutputDir.Text := SDD.FileName;
end;
end;
procedure TformImport.actOKUpdate(Sender: TObject);
begin
TAction(Sender).Enabled := FileExists(edtInputFile.Text) and
DirectoryExists(edtOutputDir.Text) and
( GetOptions() <> [] );
end;
procedure TformImport.actOKExecute(Sender: TObject);
var
tree : TwstPasTreeContainer;
oldCursor : TCursor;
srcMgnr : ISourceManager;
i : Integer;
{$IFDEF WST_IDE}
j, c : Integer;
srcItm : ISourceStream;
trueOpenFlags, openFlags : TOpenFlags;
destPath : string;
{$ENDIF}
begin
oldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
tree := ParseWsdlFile(edtInputFile.Text,@ShowStatusMessage);
try
srcMgnr := GenerateSource(tree,GetOptions(),otFileSystem,IncludeTrailingPathDelimiter(edtOutputDir.Text),@ShowStatusMessage);
ShowStatusMessage(mtInfo,'');
{$IFDEF WST_IDE}
openFlags := [];
if edtAddToProject.Checked then begin
Include(openFlags,ofAddToProject);
end;
destPath := IncludeTrailingPathDelimiter(edtOutputDir.Text);
c := srcMgnr.GetCount();
for i := 0 to Pred(c) do begin
srcItm := srcMgnr.GetItem(i);
trueOpenFlags := openFlags;
for j := 0 to Pred(LazarusIDE.ActiveProject.FileCount) do begin
if AnsiSameText(srcItm.GetFileName(),ExtractFileName(LazarusIDE.ActiveProject.Files[j].Filename)) then
trueOpenFlags := trueOpenFlags - [ofAddToProject];
end;
LazarusIDE.DoOpenEditorFile(destPath + srcItm.GetFileName(),-1,trueOpenFlags);
end;
{$ENDIF}
finally
srcMgnr := nil;
tree.Free();
end;
finally
Screen.Cursor := oldCursor;
end;
ShowMessage('File parsed succefully.');
Self.Close();
ModalResult := mrOK;
end;
initialization
{$I wstimportdlg.lrs}
end.

208
wst/tags/0.5/imp_utils.pas Normal file
View File

@ -0,0 +1,208 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit imp_utils;
interface
uses
Classes, SysUtils, TypInfo,
base_service_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Type
EPropertyManagerException = class(EServiceException)
End;
{ TPublishedPropertyManager }
TPublishedPropertyManager = class(TInterfacedObject,IPropertyManager)
Private
FParent : TObject;
procedure Error(Const AMsg:string);overload;
procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
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;
function ExtractOptionName(const ACompleteName : string):string;
implementation
function IsStrEmpty(Const AStr:String):Boolean;
begin
Result := ( Length(Trim(AStr)) = 0 );
end;
function ExtractOptionName(const ACompleteName : string):string;
var
i, c : Integer;
begin
Result := '';
c := Length(ACompleteName);
for i := c downto 1 do begin
if ( ACompleteName[i] = '_' ) then
Break;
Result := ACompleteName[i] + Result;
end;
Result := Trim(Result);
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
tkLString{$IFDEF FPC},tkSString,tkAString{$ENDIF},tkWString:
SetStrProp(FParent,pinf,AValue);
tkEnumeration :
SetEnumProp(FParent,pinf,AValue);
tkInteger,tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
Begin
If TryStrToInt64(AValue,int64Val) Then
SetOrdProp(FParent,AName,int64Val);
End;
{$IFDEF FPC}
tkBool :
SetOrdProp(FParent,AName,Ord(StrToBool(AValue)));
{$ENDIF}
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
tkLString{$IFDEF FPC},tkSString,tkAString{$ENDIF},tkWString:
Result := GetStrProp(FParent,pinf);
tkEnumeration :
Result := GetEnumProp(FParent,pinf);
tkInteger,tkInt64{$IFDEF FPC},tkQWord{$ENDIF} :
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
[ tkLString{$IFDEF FPC},tkSString,tkAString{$ENDIF},tkWString,
tkEnumeration,
tkInteger,tkInt64{$IFDEF FPC},tkQWord{$ENDIF}
]
)
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.

174
wst/tags/0.5/indy_http_protocol.pas Normal file
View File

@ -0,0 +1,174 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit indy_http_protocol;
//{$DEFINE WST_DBG}
interface
uses
Classes, SysUtils,
service_intf, imp_utils, base_service_intf,
IdHTTP;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Const
sTRANSPORT_NAME = 'HTTP';
Type
{$M+}
{ THTTPTransport }
THTTPTransport = class(TSimpleFactoryItem,ITransport)
Private
FFormat : string;
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;
property Format : string read FFormat write FFormat;
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.

298
wst/tags/0.5/indy_http_server.pas Normal file
View File

@ -0,0 +1,298 @@
{
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.
}
{$INCLUDE wst_global.inc}
{$IFDEF FPC}
//{$UNDEF INDY_9}
//{$DEFINE INDY_10}
{$ELSE}
//{$UNDEF INDY_10}
//{$DEFINE INDY_9}
{$ENDIF}
unit indy_http_server;
interface
uses
Classes, SysUtils,
IdCustomHTTPServer,
IdHTTPServer,
{$IFDEF INDY_10}
IdContext,
{$ENDIF}
{$IFDEF INDY_9}
IdTCPServer,
{$ENDIF}
IdSocketHandle,
server_listener;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
{ TwstIndyHttpListener }
TwstIndyHttpListener = class(TwstListener)
private
FHTTPServerObject: TIdHTTPServer;
FRootAddress : string;
private
procedure ProcessWSDLRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo;
var APath : string
);
procedure ProcessServiceRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo;
var APath : string
);
private
procedure Handler_CommandGet(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
{$IFDEF INDY_9}
AThread: TIdPeerThread;
{$ENDIF}
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo
);
public
constructor Create(
const AServerIpAddress : string = '127.0.0.1';
const AListningPort : Integer = 8000;
const ADefaultClientPort : Integer = 25000;
const AServerSoftware : string = 'Web Service Toolkit Application'
);
destructor Destroy(); override;
class function GetDescription() : string;override;
procedure Start();override;
procedure Stop();override;
end;
implementation
uses
{$IFNDEF FPC}
ActiveX,
{$IFDEF INDY_9}
wst_indy9_utils,
{$ENDIF}
{$ENDIF}
base_service_intf,
server_service_intf, server_service_imputils,
metadata_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;
{ TwstIndyHttpListener }
procedure TwstIndyHttpListener.ProcessWSDLRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
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 := GenerateWSDL(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 := GenerateWSDLHtmlTable();
AResponseInfo.ContentType := 'text/html';
end;
procedure TwstIndyHttpListener.ProcessServiceRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo;
var APath : string
);
var
trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
inStream : {$IFDEF FPC}TMemoryStream{$ELSE}TStringStream{$ENDIF};
begin
trgt := ExtractNextPathElement(APath);
if AnsiSameText(sWSDL,trgt) then begin
ProcessWSDLRequest({$IFDEF INDY_10}AContext,{$ENDIF}ARequestInfo,AResponseInfo,APath);
Exit;
end;
inStream := nil;
try
try
inStream := {$IFDEF FPC}TMemoryStream.Create();{$ELSE}TStringStream.Create(ARequestInfo.FormParams);{$ENDIF}
AResponseInfo.ContentStream := TMemoryStream.Create();
ctntyp := ARequestInfo.ContentType;
{$IFDEF FPC}
inStream.CopyFrom(ARequestInfo.PostStream,0);
{$ENDIF}
inStream.Position := 0;
AResponseInfo.ContentType := ctntyp;
frmt := Trim(ARequestInfo.Params.Values['format']);
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,AResponseInfo.ContentStream,frmt);
HandleServiceRequest(rqst);
finally
inStream.Free();
end;
except
on e : Exception do begin
NotifyMessage('ProcessData()>> Exception = '+e.Message);
raise;
end;
end;
end;
procedure TwstIndyHttpListener.Handler_CommandGet(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
{$IFDEF INDY_9}
AThread: TIdPeerThread;
{$ENDIF}
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo
);
var
{$IFDEF WST_DBG}
s : string;
{$ENDIF}
locPath, locPathPart : string;
j : SizeInt;
begin
{$IFDEF WST_DBG}
if Assigned(ARequestInfo.PostStream) and ( ARequestInfo.PostStream.Size > 0 ) then begin
j := ARequestInfo.PostStream.Size;
SetLength(s,j);
ARequestInfo.PostStream.Read(s[1],j);
NotifyMessage('----------- QUERY ----------------------');
Display(s);
end;
{$ENDIF}
locPath := ARequestInfo.Document;
locPathPart := ExtractNextPathElement(locPath);
if AnsiSameText(sSERVICES_PREFIXE,locPathPart) then begin
ProcessServiceRequest({$IFDEF INDY_10}AContext,{$ENDIF}ARequestInfo,AResponseInfo,locPath);
{$IFDEF WST_DBG}
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;
{$ENDIF}
Exit;
end;
ProcessWSDLRequest({$IFDEF INDY_10}AContext,{$ENDIF}ARequestInfo,AResponseInfo,locPath);
end;
constructor TwstIndyHttpListener.Create(
const AServerIpAddress : string;
const AListningPort : Integer;
const ADefaultClientPort : Integer;
const AServerSoftware : string
);
var
b : TIdSocketHandle;
begin
inherited Create();
FHTTPServerObject := TIdHTTPServer.Create({$IFDEF INDY_9}nil{$ENDIF});
{$IFDEF INDY_9}
FHTTPServerObject.ThreadClass := TwstIndy9Thread;
{$ENDIF}
b := FHTTPServerObject.Bindings.Add();
b.IP := AServerIpAddress;
b.port := AListningPort;
FRootAddress := Format('http://%s:%d/',[AServerIpAddress,AListningPort]);
FHTTPServerObject.DefaultPort := ADefaultClientPort;
FHTTPServerObject.ServerSoftware := AServerSoftware;
//FHTTPServerObject.Active := True;
FHTTPServerObject.OnCommandGet := {$IFDEF FPC}@{$ENDIF}Handler_CommandGet;
end;
destructor TwstIndyHttpListener.Destroy();
begin
if ( FHTTPServerObject <> nil ) then
Stop();
FreeAndNil(FHTTPServerObject);
inherited Destroy();
end;
procedure TwstIndyHttpListener.Start();
begin
if not FHTTPServerObject.Active then
FHTTPServerObject.Active := True;
end;
procedure TwstIndyHttpListener.Stop();
begin
if FHTTPServerObject.Active then
FHTTPServerObject.Active := False;
end;
class function TwstIndyHttpListener.GetDescription: string;
begin
Result := 'WST Indy HTTP Listener';
end;
initialization
end.

248
wst/tags/0.5/indy_tcp_server.pas Normal file
View File

@ -0,0 +1,248 @@
{
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_tcp_server;
{$INCLUDE wst_global.inc}
//{$DEFINE WST_DBG}
interface
uses
Classes, SysUtils,
IdTCPServer,
{$IFDEF INDY_10}
IdContext, IdCustomTCPServer,
{$ENDIF}
{$IFDEF INDY_9}
//IdTCPServer,
{$ENDIF}
IdSocketHandle,
server_listener;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
sSERVER_PORT = 1234;
type
{$IFDEF INDY_9}
TIdBytes = array of Byte;
{$ENDIF}
{ TwstIndyTcpListener }
TwstIndyTcpListener = class(TwstListener)
private
FTCPServerObject: TIdTCPServer;
FDefaultTime : PtrInt;
protected
procedure Handle_OnExecute(
{$IFDEF INDY_10}
AContext : TIdContext
{$ENDIF}
{$IFDEF INDY_9}
AContext : TIdPeerThread
{$ENDIF}
);
public
constructor Create(
const AServerIpAddress : string = '127.0.0.1';
const AListningPort : Integer = sSERVER_PORT;
const ADefaultClientPort : Integer = 25000
);
destructor Destroy(); override;
class function GetDescription() : string;override;
procedure Start();override;
procedure Stop();override;
end;
implementation
uses
{$IFNDEF FPC}
ActiveX,
{$IFDEF INDY_9}
wst_indy9_utils,
{$ENDIF}
{$ENDIF}
IdGlobal, binary_streamer, server_service_intf, server_service_imputils;
{ TwstIndyTcpListener }
procedure TwstIndyTcpListener.Handle_OnExecute(
{$IFDEF INDY_10}
AContext : TIdContext
{$ENDIF}
{$IFDEF INDY_9}
AContext : TIdPeerThread
{$ENDIF}
);
function ReadInputBuffer(AStream : TStream) : Integer;
var
strBuff : TIdBytes;
bufferLen : LongInt;
i, j, c : PtrInt;
begin
Result := 0;
bufferLen := 0;
try
SetLength(strBuff,SizeOf(bufferLen));
{$IFDEF INDY_10}
AContext.Connection.IOHandler.ReadBytes(strBuff,SizeOf(bufferLen),False);
{$ENDIF}
{$IFDEF INDY_9}
AContext.Connection.ReadBuffer(strBuff[0],SizeOf(bufferLen));
{$ENDIF}
Move(strBuff[0],bufferLen,SizeOf(bufferLen));
bufferLen := Reverse_32(bufferLen);
AStream.Size := bufferLen;
if ( bufferLen > 0 ) then begin
c := 0;
i := 1024;
if ( i > bufferLen ) then
i := bufferLen;
SetLength(strBuff,i);
repeat
{$IFDEF INDY_10}
AContext.Connection.IOHandler.ReadBytes(strBuff,i,False);
{$ENDIF}
{$IFDEF INDY_9}
AContext.Connection.ReadBuffer(strBuff[0],i);
{$ENDIF}
AStream.Write(strBuff[0],i);
Inc(c,i);
if ( ( bufferLen - c ) > 1024 ) then
i := 1024
else
i := bufferLen - c;
until ( i = 0 );
end;
AStream.Position := 0;
Result := AStream.Size;
finally
SetLength(strBuff,0);
end;
end;
var
locInStream, locOutStream : TMemoryStream;
wrtr : IDataStore;
rdr : IDataStoreReader;
buff, trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
i : PtrUInt;
begin
{$IFNDEF FPC}
//CoInitialize(nil);
//try
{$ENDIF}
locOutStream := nil;
locInStream := TMemoryStream.Create();
try
locOutStream := TMemoryStream.Create();
{$IFDEF INDY_10}
if ( Self.FDefaultTime <> 0 ) then
AContext.Connection.IOHandler.ReadTimeout := Self.FDefaultTime;
{$ENDIF}
if ( ReadInputBuffer(locInStream) >= SizeOf(LongInt) ) then begin
rdr := CreateBinaryReader(locInStream);
trgt := rdr.ReadStr();
ctntyp := rdr.ReadStr();
frmt := rdr.ReadStr();
buff := rdr.ReadStr();
{$IFDEF WST_DBG}
WriteLn(buff);
{$ENDIF}
rdr := nil;
locInStream.Size := 0;
locInStream.Write(buff[1],Length(buff));
locInStream.Position := 0;
rqst := TRequestBuffer.Create(trgt,ctntyp,locInStream,locOutStream,frmt);
HandleServiceRequest(rqst);
i := locOutStream.Size;
SetLength(buff,i);
locOutStream.Position := 0;
locOutStream.Read(buff[1],i);
locOutStream.Size := 0;
wrtr := CreateBinaryWriter(locOutStream);
wrtr.WriteStr(buff);
locOutStream.Position := 0;
{$IFDEF INDY_10}
AContext.Connection.IOHandler.Write(locOutStream,locOutStream.Size,False);
{$ENDIF}
{$IFDEF INDY_9}
AContext.Connection.WriteStream(locOutStream,True,False,locOutStream.Size);
{$ENDIF}
end;
finally
FreeAndNil(locOutStream);
FreeAndNil(locInStream);
end;
{$IFNDEF FPC}
//finally
//CoUninitialize();
//end;
{$ENDIF}
end;
constructor TwstIndyTcpListener.Create(
const AServerIpAddress : string;
const AListningPort : Integer;
const ADefaultClientPort : Integer
);
var
b : TIdSocketHandle;
begin
inherited Create();
FTCPServerObject := TIdTCPServer.Create({$IFNDEF INDY_10}nil{$ENDIF});
{$IFDEF INDY_9}
FTCPServerObject.ThreadClass := TwstIndy9Thread;
{$ENDIF}
b := FTCPServerObject.Bindings.Add();
b.IP := AServerIpAddress;
b.port := AListningPort;
FTCPServerObject.DefaultPort := ADefaultClientPort;
FTCPServerObject.OnExecute := {$IFDEF FPC}@{$ENDIF}Handle_OnExecute;
end;
destructor TwstIndyTcpListener.Destroy();
begin
if ( FTCPServerObject <> nil ) then
Stop();
FreeAndNil(FTCPServerObject);
inherited Destroy();
end;
class function TwstIndyTcpListener.GetDescription() : string;
begin
Result := 'WST Indy TCP Listener';
end;
procedure TwstIndyTcpListener.Start();
begin
if not FTCPServerObject.Active then
FTCPServerObject.Active := True;
end;
procedure TwstIndyTcpListener.Stop();
begin
if FTCPServerObject.Active then
FTCPServerObject.Active := False;
end;
end.

89
wst/tags/0.5/library_base_intf.pas Normal file
View File

@ -0,0 +1,89 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit library_base_intf;
interface
uses base_service_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
RET_OK = 0;
RET_FALSE = 1;
WST_LIB_HANDLER = 'wstHandleRequest';
type
EwstCheckException = class(EServiceException)
private
FReturnCode: Integer;
public
property ReturnCode : Integer read FReturnCode write FReturnCode;
end;
IwstStream = interface
['{95700F89-3E36-4678-AD84-347162E39288}']
function Read(
ABuffer : Pointer;
const ALenToRead : LongWord;
out AReadedLen : LongWord
):LongInt;
function Write(
ABuffer : Pointer;
const ALenToWrite : LongWord;
out AWrittenLen : LongWord
):LongInt;
function GetSize(out ASize : LongWord):LongInt;
function SetSize(const ANewSize : LongWord):LongInt;
function GetPosition(out APos : LongWord):LongWord;
function SetPosition(const ANewPos : LongWord):LongInt;
end;
TwstLibraryHandlerFunction =
function(
ARequestBuffer : IwstStream;
AErrorBuffer : Pointer;
var AErrorBufferLen : LongInt
):LongInt;
procedure wstCheck(const AReturn : LongInt);overload;
procedure wstCheck(const AReturn : LongInt; const AMsg : string);overload;
implementation
procedure wstCheck(const AReturn : LongInt);
var
e : EwstCheckException;
begin
if ( AReturn <> RET_OK ) then begin
e := EwstCheckException.CreateFmt('wst Check Exception , return = %d',[AReturn]);
e.ReturnCode := AReturn;
raise e;
end;
end;
procedure wstCheck(const AReturn : LongInt; const AMsg : string);
var
e : EwstCheckException;
begin
if ( AReturn <> RET_OK ) then begin
e := EwstCheckException.Create(AMsg);
e.ReturnCode := AReturn;
raise e;
end;
end;
end.

199
wst/tags/0.5/library_imp_utils.pas Normal file
View File

@ -0,0 +1,199 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit library_imp_utils;
interface
uses
Classes, SysUtils;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
IwstModule = interface
['{A62A9A71-727E-47AD-9B84-0F7CA0AE51D5}']
function GetFileName():string;
function GetProc(const AProcName : string):Pointer;
end;
IwstModuleManager = interface
['{0A49D315-FF3E-40CD-BCA0-F958BCD5C57F}']
function Get(const AFileName : string):IwstModule;
procedure Clear();
end;
var
LibraryManager : IwstModuleManager = nil;
implementation
{$IFDEF FPC}
uses DynLibs;
{$ELSE}
uses Windows;
type TLibHandle = THandle;
const NilHandle = 0;
{$ENDIF}
type
{ TwstModule }
TwstModule = class(TInterfacedObject,IwstModule)
private
FFileName : string;
FHandle : TLibHandle;
private
procedure Load(const ADoLoad : Boolean);
protected
function GetFileName():string;
function GetProc(const AProcName : string):Pointer;
public
constructor Create(const AFileName : string);
destructor Destroy();override;
end;
{ TwstModuleManager }
TwstModuleManager = class(TInterfacedObject,IwstModuleManager)
private
FList : IInterfaceList;
private
function Load(const AFileName : string):IwstModule;
function GetItem(const AIndex : Integer):IwstModule;
function IndexOf(const AFileName : string):Integer;
protected
function Get(const AFileName : string):IwstModule;
procedure Clear();
public
constructor Create();
destructor Destroy();override;
end;
procedure TwstModule.Load(const ADoLoad : Boolean);
begin
if ADoLoad then begin
if ( FHandle = NilHandle ) then begin
{$IFDEF FPC}
FHandle := LoadLibrary(FFileName);
{$ELSE}
FHandle := LoadLibrary(PCHAR(FFileName));
{$ENDIF}
if ( FHandle = NilHandle ) then
raise Exception.CreateFmt('Error while loading : "%s".',[FFileName]);
end;
end else begin
if ( FHandle <> NilHandle ) then begin
FreeLibrary(FHandle);
FHandle := NilHandle;
end;
end;
end;
function TwstModule.GetFileName(): string;
begin
Result := FFileName;
end;
function TwstModule.GetProc(const AProcName: string): Pointer;
begin
{$IFDEF FPC}
Result := GetProcAddress(FHandle,AProcName);
{$ELSE}
Result := GetProcAddress(FHandle,PCHAR(AProcName));
{$ENDIF}
if not Assigned(Result) then
raise Exception.CreateFmt('Procedure "%s" not found in this module( "%s" ).',[AProcName,FFileName]);
end;
constructor TwstModule.Create(const AFileName: string);
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt('File not found : "%s".',[AFileName]);
FHandle := NilHandle;
FFileName := AFileName;
Load(True);
end;
destructor TwstModule.Destroy();
begin
Load(False);
inherited Destroy();
end;
{ TwstModuleManager }
function TwstModuleManager.Get(const AFileName: string): IwstModule;
var
i : Integer;
begin
i := IndexOf(AFileName);
if ( i < 0 ) then
Result := Load(AFileName)
else
Result := GetItem(i);
end;
procedure TwstModuleManager.Clear();
begin
FList.Clear();
end;
function TwstModuleManager.Load(const AFileName: string): IwstModule;
begin
Result := TwstModule.Create(AFileName);
end;
function TwstModuleManager.GetItem(const AIndex: Integer): IwstModule;
begin
Result := FList[AIndex] as IwstModule;
end;
function TwstModuleManager.IndexOf(const AFileName: string): Integer;
begin
for Result := 0 to Pred(FList.Count) do begin
if AnsiSameStr(AFileName,(FList[Result] as IwstModule).GetFileName()) then
Exit;
end;
Result := -1;
end;
constructor TwstModuleManager.Create();
begin
inherited;
FList := TInterfaceList.Create();
end;
destructor TwstModuleManager.Destroy();
begin
FList := nil;
inherited Destroy();
end;
procedure InitLibraryManager();
begin
LibraryManager := TwstModuleManager.Create();
end;
initialization
InitLibraryManager();
finalization
LibraryManager := nil;
end.

250
wst/tags/0.5/library_protocol.pas Normal file
View File

@ -0,0 +1,250 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit library_protocol;
//{$DEFINE WST_DBG}
interface
uses
Classes, SysUtils,{$IFDEF WST_DBG}Dialogs,{$ENDIF}
service_intf, imp_utils, base_service_intf, library_base_intf,
library_imp_utils;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
sTRANSPORT_NAME = 'LIB';
Type
{$M+}
{ TLIBTransport }
TLIBTransport = class(TSimpleFactoryItem,ITransport)
Private
FPropMngr : IPropertyManager;
FModule : IwstModule;
FHandler : TwstLibraryHandlerFunction;
private
FContentType: string;
FFileName: string;
FTarget: string;
private
FFormat : string;
procedure SetFileName(const AValue: string);
procedure LoadModule();
public
constructor Create();override;
destructor Destroy();override;
function GetPropertyManager():IPropertyManager;
procedure SendAndReceive(ARequest,AResponse:TStream);
published
property ContentType : string read FContentType write FContentType;
property Target : string read FTarget write FTarget;
property FileName : string read FFileName write SetFileName;
property Format : string read FFormat write FFormat;
end;
{$M+}
procedure LIB_Register_Transport();
implementation
uses binary_streamer;
type
{ TwstStream }
TwstStream = class(TInterfacedObject,IwstStream)
private
FStream : TStream;
protected
function Read(
ABuffer : Pointer;
const ALenToRead : LongWord;
out AReadedLen : LongWord
):LongInt;
function Write(
ABuffer : Pointer;
const ALenToWrite : LongWord;
out AWrittenLen : LongWord
):LongInt;
function GetSize(out ASize : LongWord):LongInt;
function SetSize(const ANewSize : LongWord):LongInt;
function GetPosition(out APos : LongWord):LongWord;
function SetPosition(const ANewPos : LongWord):LongInt;
public
constructor Create(AStream : TStream);
end;
{ TwstStream }
function TwstStream.Read(
ABuffer : Pointer;
const ALenToRead : LongWord;
out AReadedLen : LongWord
): LongInt;
begin
try
AReadedLen := FStream.Read(ABuffer^,ALenToRead);
Result := RET_OK;
except
Result := RET_FALSE;
end;
end;
function TwstStream.Write(
ABuffer : Pointer;
const ALenToWrite : LongWord;
out AWrittenLen : LongWord
): LongInt;
begin
try
AWrittenLen := FStream.Write(ABuffer^,ALenToWrite);
Result := RET_OK;
except
Result := RET_FALSE;
end;
end;
function TwstStream.GetSize(out ASize: LongWord): LongInt;
begin
ASize := FStream.Size;
Result := RET_OK;
end;
function TwstStream.SetSize(const ANewSize: LongWord): LongInt;
begin
FStream.Size := ANewSize;
Result := RET_OK;
end;
function TwstStream.GetPosition(out APos: LongWord): LongWord;
begin
APos := FStream.Position;
Result := RET_OK;
end;
function TwstStream.SetPosition(const ANewPos: LongWord): LongInt;
begin
FStream.Position := ANewPos;
Result := RET_OK;
end;
constructor TwstStream.Create(AStream: TStream);
begin
Assert(Assigned(AStream));
FStream := AStream;
end;
{ TLIBTransport }
procedure TLIBTransport.SetFileName(const AValue: string);
begin
FFileName := AValue;
if Assigned(FModule) and ( not AnsiSameStr(FFileName,FModule.GetFileName()) ) then begin
FHandler := nil;
FModule := nil;
end;
end;
procedure TLIBTransport.LoadModule();
begin
if ( FModule = nil ) then begin
FModule := LibraryManager.Get(FFileName);
FHandler := TwstLibraryHandlerFunction(FModule.GetProc(WST_LIB_HANDLER));
end;
end;
constructor TLIBTransport.Create();
begin
inherited Create();
FPropMngr := TPublishedPropertyManager.Create(Self);
FModule := nil;
FHandler := nil
end;
destructor TLIBTransport.Destroy();
begin
FPropMngr := Nil;
FModule := nil;
FHandler := nil;
inherited Destroy();
end;
function TLIBTransport.GetPropertyManager(): IPropertyManager;
begin
Result := FPropMngr;
end;
const MAX_ERR_LEN = 500;
procedure TLIBTransport.SendAndReceive(ARequest, AResponse: TStream);
Var
wrtr : IDataStore;
buffStream : TMemoryStream;
strBuff : string;
intfBuffer : IwstStream;
bl : LongInt;
{$IFDEF WST_DBG}
s : string;
i : Int64;
{$ENDIF WST_DBG}
begin
LoadModule();
buffStream := TMemoryStream.Create();
try
wrtr := CreateBinaryWriter(buffStream);
wrtr.WriteInt32S(0);
wrtr.WriteStr(Target);
wrtr.WriteStr(ContentType);
wrtr.WriteStr(Self.Format);
SetLength(strBuff,ARequest.Size);
ARequest.Position := 0;
ARequest.Read(strBuff[1],Length(strBuff));
wrtr.WriteStr(strBuff);
buffStream.Position := 0;
wrtr.WriteInt32S(buffStream.Size-4);
buffStream.Position := 0;
intfBuffer := TwstStream.Create(buffStream);
bl := MAX_ERR_LEN;
strBuff := StringOfChar(#0,bl);
if ( FHandler(intfBuffer,Pointer(strBuff),bl) <> RET_OK ) then
raise Exception.Create(strBuff);
buffStream.Position := 0;
AResponse.Size := 0;
AResponse.CopyFrom(buffStream,0);
AResponse.Position := 0;
{$IFDEF WST_DBG}
i := AResponse.Position;
SetLength(s,AResponse.Size);
AResponse.Read(s[1],AResponse.Size);
if IsConsole then
WriteLn(s)
else
ShowMessage(s);
{$ENDIF WST_DBG}
finally
buffStream.Free();
end;
end;
procedure LIB_Register_Transport();
begin
GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TLIBTransport) as IItemFactory);
end;
end.

124
wst/tags/0.5/library_server_intf.pas Normal file
View File

@ -0,0 +1,124 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit library_server_intf;
interface
uses
Classes, SysUtils,
library_base_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
function wstHandleRequest(
ARequestBuffer : IwstStream;
AErrorBuffer : Pointer;
var AErrorBufferLen : LongInt
):LongInt;
implementation
uses base_service_intf, server_service_intf, server_service_imputils, binary_streamer;
function wstHandleRequest(
ARequestBuffer : IwstStream;
AErrorBuffer : Pointer;
var AErrorBufferLen : LongInt
):LongInt;
procedure CopyErrMsg(const AMsg : string);
var
j,m : Integer;
begin
m := AErrorBufferLen;
j := Length(AMsg);
if ( j > 0 ) then begin
if ( j > m ) then
j := m;
try
Move(AMsg[1],AErrorBuffer^,j);
except
end;
end;
end;
Var
buff, trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
rdr : IDataStoreReader;
inStream, bufStream : TMemoryStream;
bs, bytesCount : LongWord;
begin
Result := RET_FALSE;
try
inStream := nil;
bufStream := nil;
if Assigned(ARequestBuffer) then begin
wstCheck(ARequestBuffer.GetSize(bs));
if ( bs > 0 ) then begin
try
inStream := TMemoryStream.Create();
bufStream := TMemoryStream.Create();
bufStream.Size := bs;
wstCheck(ARequestBuffer.SetPosition(0));
wstCheck(ARequestBuffer.Read(bufStream.Memory,bs,bytesCount));
if ( bs <> bytesCount ) then
wstCheck(RET_FALSE,'Invalid buffer operation (READ)');
wstCheck(ARequestBuffer.SetSize(0));
bufStream.Position := 0;
rdr := CreateBinaryReader(bufStream);
if ( rdr.ReadInt32S() <> ( bs - 4 ) ) then
wstCheck(RET_FALSE,'Invalid buffer.');
trgt := rdr.ReadStr();
ctntyp := rdr.ReadStr();
frmt := rdr.ReadStr();
buff := rdr.ReadStr();
rdr := nil;
bufStream.Size := 0;
bufStream.Position := 0;
inStream.Write(buff[1],Length(buff));
SetLength(buff,0);
inStream.Position := 0;
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream,frmt);
HandleServiceRequest(rqst);
bs := bufStream.Size;
wstCheck(ARequestBuffer.SetSize(bs));
wstCheck(ARequestBuffer.SetPosition(0));
wstCheck(ARequestBuffer.Write(bufStream.Memory,bs,bytesCount));
if ( bs <> bytesCount ) then
wstCheck(RET_FALSE,'Invalid buffer operation (WRITE)');
Result := RET_OK;
finally
bufStream.Free();
inStream.Free();
end;
end;
end;
except
on e : EwstCheckException do begin
Result := e.ReturnCode;
CopyErrMsg(e.Message);
end;
on e : Exception do begin
Result := RET_FALSE;
CopyErrMsg(e.Message);
end else begin
Result := RET_FALSE;
end;
end;
end;
end.

827
wst/tags/0.5/metadata_repository.pas Normal file
View File

@ -0,0 +1,827 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit metadata_repository;
interface
uses
Classes, SysUtils, TypInfo;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
sWST_SIGNATURE = 'WST_METADATA_0.2.2.0';
sWST_META = 'wst_meta';
sFORMAT = 'FORMAT';
sTRANSPORT = 'TRANSPORT';
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;
Properties : PPropertyData;
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 SetServiceCustomData(
const ARepName : shortstring;
const AServiceName : shortstring;
const ADataName,
AData : string
);
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);
function Find(const AProps : PPropertyData; const APropName : string) : PPropertyData;
function GetServiceDefaultAddress(AServiceTyp : PTypeInfo):string;
function GetServiceDefaultFormatProperties(AServiceTyp : PTypeInfo):string;
implementation
uses wst_resources_imp, binary_streamer, imp_utils;
{$INCLUDE wst_rtl_imp.inc}
const sADDRESS = 'Address';
function GetServiceDefaultAddress(AServiceTyp : PTypeInfo):string;
var
typData : PTypeData;
servcMdt : PService;
propData : PPropertyData;
begin
Result := '';
if Assigned(AServiceTyp) and (AServiceTyp^.Kind = tkInterface) then begin
typData := GetTypeData(AServiceTyp);
if Assigned(typData) then begin
servcMdt := GetModuleMetadataMngr().GetServiceMetadata(typData^.IntfUnit,AServiceTyp^.Name);
if Assigned(AServiceTyp) then begin
propData := Find(servcMdt^.Properties,sTRANSPORT + '_' + sADDRESS);
if Assigned(propData) then
Result := propData^.Data;
end;
end;
end;
end;
function GetServiceDefaultFormatProperties(AServiceTyp : PTypeInfo):string;
var
typData : PTypeData;
servcMdt : PService;
propData : PPropertyData;
strName : string;
begin
Result := '';
if Assigned(AServiceTyp) and (AServiceTyp^.Kind = tkInterface) then begin
typData := GetTypeData(AServiceTyp);
if Assigned(typData) then begin
servcMdt := GetModuleMetadataMngr().GetServiceMetadata(typData^.IntfUnit,AServiceTyp^.Name);
if Assigned(AServiceTyp) then begin
propData := servcMdt^.Properties;
while Assigned(propData) do begin
if ( AnsiPos(sFORMAT + '_',propData^.Name) = 1 ) then begin
strName := ExtractOptionName(propData^.Name);
if ( Length(strName) > 0 ) then begin
Result := Format('%s%s=%s;',[Result,strName,propData^.Data]);
end;
end;
propData := propData^.Next;
end;
if not IsStrEmpty(Result) then begin
Delete(Result,Length(Result),1);
end;
end;
end;
end;
end;
procedure ClearProperties(var AProps : PPropertyData);
var
c : Integer;
q, p : PPropertyData;
begin
if not Assigned(AProps) then
Exit;
c := SizeOf(TPropertyData);
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(TPropertyData);
q0 := wst_GetMem(c);
q := q0;
p := AProps;
while Assigned(p) do begin
q^.Next := wst_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 := wst_GetMem(SizeOf(TPropertyData));
FillChar(AProps^,SizeOf(TPropertyData),#0);
AProps^.Next := nil;
Result := AProps;
end else begin
Result := Find(AProps,APropName);
if not Assigned(Result) then begin
Result := wst_GetMem(SizeOf(TPropertyData));
FillChar(Result^,SizeOf(TPropertyData),#0);
Result^.Next := AProps;
AProps := Result;
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(TOperationParam) );
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]));
ClearOperation(po);
Inc(po);
end;
Freemem(AService^.Operations, k * SizeOf(TServiceOperation) );
AService^.Operations := nil;
ClearProperties(AService^.Properties);
AService^.Properties := nil;
end;
if AFreeService then
Freemem(AService,SizeOf(TService));
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);
ClearService(ps,false);
Inc(ps);
end;
Freemem(ARepository^.Services, c * SizeOf(TService) );
end;
Freemem(ARepository,SizeOf(TServiceRepository));
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 := wst_GetMem( cc * SizeOf(TOperationParam) );
FillChar(AOperation^.Params^, cc * SizeOf(TOperationParam), #0);
AOperation^.ParamsCount := cc;
pp := AOperation^.Params;
for ii := 0 to Pred(cc) do begin
//LoadParam(@(pp[ii]));
LoadParam(pp);
Inc(pp);
end;
end;
end;
var
j, k : LongInt;
po : PServiceOperation;
begin
AService^.Name := rdr.ReadStr();
AService^.Properties := nil;
k := rdr.ReadInt8U();
if ( k > 0 ) then begin
AService^.Operations := wst_GetMem( k * SizeOf(TServiceOperation) );
AService^.OperationsCount := k;
FillChar(AService^.Operations^,k * SizeOf(TServiceOperation), #0);
po := AService^.Operations;
for j := 0 to Pred(k) do begin
//LoadOperation(@(po[j]));
LoadOperation(po);
Inc(po);
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(TServiceRepository);
ARepository := wst_GetMem(c);
try
FillChar(ARepository^,c,#0);
ARepository^.Name := rdr.ReadStr();
c := rdr.ReadInt8U();
if ( c > 0 ) then begin
ARepository^.Services := wst_GetMem( c * SizeOf(TService) );
ARepository^.ServicesCount := c;
FillChar(ARepository^.Services^,c * SizeOf(TService),#0);
ps := ARepository^.Services;
for i := 0 to Pred(c) do begin
//LoadService(@(ps[i]));
LoadService(ps);
Inc(ps);
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;
ppSrc, pp : POperationParam;
begin
ADstOperation^.Name := ASrcOperation^.Name;
ADstOperation^.Properties := CloneProperties(ASrcOperation^.Properties);
cc := ASrcOperation^.ParamsCount;
if ( cc > 0 ) then begin
ADstOperation^.Params := wst_GetMem( cc * SizeOf(TOperationParam) );
FillChar(ADstOperation^.Params^, cc * SizeOf(TOperationParam), #0);
ADstOperation^.ParamsCount := cc;
ppSrc := ASrcOperation^.Params;
pp := ADstOperation^.Params;
for ii := 0 to Pred(cc) do begin
//CopyParam(@(ASrcOperation^.Params[ii]),@(pp[ii]));
CopyParam(ppSrc,pp);
Inc(ppSrc);
Inc(pp);
end;
end;
end;
var
j, k : LongInt;
poSrc, po : PServiceOperation;
begin
ADestService^.Name := ASrcService^.Name;
ADestService^.Properties := CloneProperties(ASrcService^.Properties);
k := ASrcService^.OperationsCount;
if ( k > 0 ) then begin
ADestService^.Operations := wst_GetMem( k * SizeOf(TServiceOperation) );
ADestService^.OperationsCount := k;
FillChar(ADestService^.Operations^,k * SizeOf(TServiceOperation), #0);
po := ADestService^.Operations;
poSrc := ASrcService^.Operations;
for j := 0 to Pred(k) do begin
//CopyOperation(@(ASrcService^.Operations[j]),@(po[j]));
CopyOperation(poSrc,po);
Inc(poSrc);
Inc(po);
end;
end;
end;
function CloneService(const ASrcService : PService) : PService;
var
c : Integer;
begin
c := SizeOf(TService);
Result := wst_GetMem(c);
FillChar(Result^,c,#0);
CopyService(ASrcService,Result);
end;
procedure CloneRepository(
const ASource : PServiceRepository;
out ADest : PServiceRepository
);
var
i, c : LongInt;
psSrc, ps : PService;
begin
ADest := nil;
if not Assigned(ASource) then
Exit;
c := SizeOf(TServiceRepository);
ADest := wst_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 := wst_GetMem( c * SizeOf(TService) );
ADest^.ServicesCount := c;
FillChar(ADest^.Services^,c * SizeOf(TService),#0);
ps := ADest^.Services;
psSrc := ASource^.Services;
for i := 0 to Pred(c) do begin
//CopyService(@(ASource^.Services[i]),@(ps[i]));
CopyService(psSrc,ps);
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 SetServiceCustomData(
const ARepName : shortstring;
const AServiceName : shortstring;
const ADataName,
AData : string
);
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 : Integer;
L : TStrings;
begin
L:=TStringList.Create;
Try
GetWSTResourceManager.GetResourceList(L);
For I:=0 to L.Count-1 do
RegisterRepository(L[i]);
finally
L.Free;
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;
tmpRes : PServiceRepository;
begin
If not GetWSTResourceManager.HasResource(ARepName) then
raise EMetadataException.CreateFmt('Repository not registered : "%s"',[ARepName]);
Result := FindInnerListIndex(ARepName);
if ( Result < 0 ) then begin
tmpStrm := TMemoryStream.Create();
try
strBuffer := GetWSTResourceManager.ResourceAsString(ARepName);
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;
srv : PService;
begin
srv := ARep^.Services;
for i := 0 to Pred(ARep^.ServicesCount) do begin
//if AnsiSameText(AServiceName,ARep^.Services[i].Name) then begin
if AnsiSameText(AServiceName,srv^.Name) then begin
Result := srv;
Exit;
end;
Inc(srv);
end;
Result := nil;
end;
procedure TModuleMetadataMngr.SetServiceCustomData(
const ARepName : shortstring;
const AServiceName : shortstring;
const ADataName,
AData : string
);
var
i : Integer;
rp : PServiceRepository;
sp : PService;
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]);
Add(sp^.Properties,ADataName,AData);
end;
function FindOperation(
const AServ : PService;
const AOperationName : shortstring
) : PServiceOperation;
var
i : Integer;
sop : PServiceOperation;
begin
sop := AServ^.Operations;
for i := 0 to Pred(AServ^.OperationsCount) do begin
if AnsiSameText(AOperationName,sop^.Name) then begin
Result := sop;
Exit;
end;
Inc(sop);
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];
Result := FindService(rp,AServiceName);
if ( Result <> nil ) then begin
Result := CloneService(Result);
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.

254
wst/tags/0.5/metadata_service.pas Normal file
View File

@ -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.
}
{$INCLUDE wst_global.inc}
unit metadata_service;
interface
uses
Classes, SysUtils,
base_service_intf, metadata_repository;
{$INCLUDE wst.inc}
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.

7
wst/tags/0.5/metadata_service.wst Normal file
View File

@ -0,0 +1,7 @@
GetWSTResourceManager().AddResource('METADATA_SERVICE',
#0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#16'metadata_service'#1#0#0#0#19'IWSTMe'
+'tadataService'#2#0#0#0#17'GetRepositoryList'#1#0#0#0#6'result'#0#0#0#23'TAr'
+'rayOfStringRemotable'#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''
);

BIN
wst/tags/0.5/metadata_service.wst_meta Normal file
View File

Binary file not shown.

151
wst/tags/0.5/metadata_service_binder.pas Normal file
View File

@ -0,0 +1,151 @@
{
This unit has been produced by ws_helper.
Input unit name : "metadata_service".
This unit name : "metadata_service_binder".
Date : "12/11/2006 11:12".
}
{$INCLUDE wst_global.inc}
unit metadata_service_binder;
interface
uses SysUtils, Classes, base_service_intf, server_service_intf, metadata_service;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
TWSTMetadataService_ServiceBinder=class(TBaseServiceBinder)
Protected
procedure GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
Public
constructor Create();
End;
{ TWSTMetadataService_ServiceBinderFactory }
TWSTMetadataService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
private
FInstance : IInterface;
protected
function CreateInstance():IInterface;
public
constructor Create();
destructor Destroy();override;
end;
procedure Server_service_RegisterWSTMetadataServiceService();
Implementation
uses TypInfo, wst_resources_imp,metadata_repository;
{ TWSTMetadataService_ServiceBinder implementation }
procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
Var
cllCntrl : ICallControl;
tmpObj : IWSTMetadataService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
returnVal : TArrayOfStringRemotable;
Begin
callCtx := AContext;
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(callCtx);
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; AContext : ICallContext);
Var
cllCntrl : ICallControl;
tmpObj : IWSTMetadataService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AName : string;
returnVal : TWSTMtdRepository;
Begin
callCtx := AContext;
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(callCtx);
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',{$IFDEF FPC}@{$ENDIF}GetRepositoryListHandler);
RegisterVerbHandler('GetRepositoryInfo',{$IFDEF FPC}@{$ENDIF}GetRepositoryInfoHandler);
End;
{ TWSTMetadataService_ServiceBinderFactory }
function TWSTMetadataService_ServiceBinderFactory.CreateInstance():IInterface;
Begin
Result := FInstance;
End;
constructor TWSTMetadataService_ServiceBinderFactory.Create();
begin
FInstance := TWSTMetadataService_ServiceBinder.Create();
end;
destructor TWSTMetadataService_ServiceBinderFactory.Destroy();
begin
FInstance := nil;
inherited Destroy();
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();
{$IFEND}
{$i metadata_service.wst}
End.

145
wst/tags/0.5/metadata_service_imp.pas Normal file
View File

@ -0,0 +1,145 @@
{
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".
}
{$INCLUDE wst_global.inc}
Unit metadata_service_imp;
Interface
Uses SysUtils, Classes,
base_service_intf, server_service_intf, server_service_imputils, metadata_service;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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;
pprm : POperationParam;
begin
if Assigned(ARawOper) and Assigned(AObjOper) then begin
AObjOper.Name :=ARawOper^.Name;
cc := ARawOper^.ParamsCount;
AObjOper.Params.SetLength(cc);
if ( cc > 0 ) then begin
pprm := ARawOper^.Params;
for ii := 0 to Pred(cc) do begin
LoadParam(pprm,AObjOper.Params[ii]);
Inc(pprm);
end;
end;
end;
end;
var
k, d : Integer;
pservOP : PServiceOperation;
begin
if Assigned(ARawServ) and Assigned(AObjServ) then begin
AObjServ.Name :=ARawServ^.Name;
d := ARawServ^.OperationsCount;
AObjServ.Operations.SetLength(d);
if ( d > 0 ) then begin
pservOP := ARawServ^.Operations;
for k := 0 to Pred(d) do begin
LoadOperation(pservOP,AObjServ.Operations[k]);
Inc(pservOP);
end;
end;
end;
end;
var
repData : PServiceRepository;
mn : IModuleMetadataMngr;
i, c : Integer;
pserv : PService;
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
pserv := repData^.Services;
for i := 0 to Pred(c) do begin
LoadService(pserv,Result.Services[i]);
Inc(pserv);
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.

94
wst/tags/0.5/metadata_service_proxy.pas Normal file
View File

@ -0,0 +1,94 @@
{
This unit has been produced by ws_helper.
Input unit name : "metadata_service".
This unit name : "metadata_service_proxy".
Date : "12/11/2006 11:12".
}
{$INCLUDE wst_global.inc}
Unit metadata_service_proxy;
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, metadata_service;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Type
TWSTMetadataService_Proxy=class(TBaseProxy,IWSTMetadataService)
Protected
class function GetServiceType() : PTypeInfo;override;
function GetRepositoryList():TArrayOfStringRemotable;
function GetRepositoryInfo(
Const AName : string
):TWSTMtdRepository;
End;
Implementation
uses wst_resources_imp, 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.wst}
{$IF DECLARED(Register_metadata_service_ServiceMetadata)}
Register_metadata_service_ServiceMetadata();
{$ENDIF}
End.

879
wst/tags/0.5/metadata_wsdl.pas Normal file
View File

@ -0,0 +1,879 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit metadata_wsdl;
interface
uses
Classes, SysUtils, TypInfo,
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
base_service_intf, metadata_repository;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
IWsdlTypeHandler = interface
['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}']
procedure Generate(
const APascalTypeName : string;
AWsdlDocument : TXMLDocument
);
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 : TXMLDocument
);
end;
{ TBaseComplexRemotable_TypeHandler }
TBaseComplexRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
protected
procedure Generate(
const APascalTypeName : string;
AWsdlDocument : TXMLDocument
);
end;
{ TBaseObjectArrayRemotable_TypeHandler }
TBaseArrayRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
protected
procedure Generate(
const APascalTypeName : string;
AWsdlDocument : TXMLDocument
);
end;
procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TXMLDocument);overload;
function GenerateWSDL(const ARepName, ARootAddress : string):string;overload;
function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry;
implementation
uses
{$IFNDEF FPC}
wst_delphi_rtti_utils
{$ELSE}
wst_fpc_xml, XmlWrite
{$ENDIF};
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';
sFORMAT_Input_EncodingStyle = 'FORMAT_Input_EncodingStyle';
sFORMAT_Input_EncodingStyleURI = 'FORMAT_Input_EncodingStyleURI';
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 : TXMLDocument):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
else
i := 0;
for i := i 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 : TXMLDocument
):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',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ;
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 : TXMLDocument);
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;
if ( cc > 0 ) then begin
pp := AOperation^.Params;
for ii := 0 to Pred(cc) do begin
if ( pp^.Modifier in [opfNone, opfIn] ) then
GenerateParam(pp,qryNode)
else if ( pp^.Modifier in [opfVar, opfOut] ) then
GenerateParam(pp,rspNode);
Inc(pp);
end;
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 begin
GenerateOperationMessage(po);
Inc(po);
end;
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,prtTypeNode);
Inc(po);
end;
end;
end;
procedure GenerateServiceBinding(AService : PService; ARootNode : TDOMElement);
procedure GenerateOperation(AOperation : PServiceOperation; ABndngNode : TDOMElement);
var
opNode, inNode, outNode, bdyNode : TDOMElement;
strBuff : string;
propData : PPropertyData;
encdStyl,encdStylURI : 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);
CreateElement(strBuff,opNode,ADoc).SetAttribute(sSOAP_ACTION,Format('%s/%s%s',[AMdtdRep^.NameSpace,AService^.Name,AOperation^.Name]));
inNode := CreateElement(sWSDL_INPUT,opNode,ADoc);
strBuff := Format('%s:%s',[sSOAP,sBODY]);
bdyNode := CreateElement(strBuff,inNode,ADoc);
encdStyl := 'literal';
encdStylURI := '';
propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyle);
if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin
encdStyl := Trim(propData^.Data);
end;
bdyNode.SetAttribute(sSOAP_USE,encdStyl);
bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace]));
propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyleURI);
if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin
encdStylURI := Trim(propData^.Data);
end;
if ( Length(encdStylURI) > 0 ) then
bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI);
outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc);
strBuff := Format('%s:%s',[sSOAP,sBODY]);
bdyNode := CreateElement(strBuff,outNode,ADoc);
bdyNode.SetAttribute(sSOAP_USE,encdStyl);
bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace]));
if ( Length(encdStylURI) > 0 ) then
bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI);
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,bndgNode);
Inc(po);
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,defNode);
Inc(ps);
end;
ps := AMdtdRep^.Services;
for i := 0 to Pred(c) do begin
GenerateServicePortType(ps,defNode);
Inc(ps);
end;
ps := AMdtdRep^.Services;
for i := 0 to Pred(c) do begin
GenerateServiceBinding(ps,defNode);
Inc(ps);
end;
ps := AMdtdRep^.Services;
for i := 0 to Pred(c) do begin
GenerateServicePublication(ps,defNode);
Inc(ps);
end;
end;
end;
function GenerateWSDL(const ARepName, ARootAddress : string):string;overload;
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 := CreateDoc();
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
ReleaseDomNode(doc);
strm.Free();
GetModuleMetadataMngr().ClearRepository(rep);
end;
end;
function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry;
begin
Result := WsdlTypeHandlerRegistryInst;
end;
type
{ TFakeTypeHandler }
TFakeTypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler)
protected
procedure Generate(
const APascalTypeName : string;
AWsdlDocument : TXMLDocument
);
end;
{ TBaseComplexRemotable_TypeHandler }
procedure TBaseComplexRemotable_TypeHandler.Generate(
const APascalTypeName : string;
AWsdlDocument : TXMLDocument
);
var
typItm, propTypItm : TTypeRegistryItem;
s, prop_ns_shortName : string;
defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : 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 := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
Assert(Assigned(defTypesNode));
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
cplxNode := CreateElement(s,defSchemaNode,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,typItm.GetExternalPropertyName(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: TXMLDocument
);
var
typItm : TTypeRegistryItem;
ns_shortName, s : string;
defTypesNode, defSchemaNode, resNode, restrictNode : 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',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ;
AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,ns_shortName]),typItm.NameSpace);
end;
defTypesNode := FindNode(AWsdlDocument.DocumentElement,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));
CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(
sVALUE,
typItm.GetExternalPropertyName(GetEnumName(typItm.DataType,i))
);
end;
end;
end;
{ TFakeTypeHandler }
procedure TFakeTypeHandler.Generate(
const APascalTypeName: string;
AWsdlDocument: TXMLDocument
);
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);
{$IFDEF FPC}
r.RegisterDefaultHandler(tkQWord,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkSString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkAString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkBool,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
{$ENDIF}
r.RegisterDefaultHandler(tkLString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkWString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory);
r.RegisterDefaultHandler(tkWString,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: TXMLDocument
);
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',[GetNodeListCount(AWsdlDocument.DocumentElement.Attributes)]) ;
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 : 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 := FindNode(AWsdlDocument.DocumentElement,sWSDL_TYPES) as TDOMElement;
Assert(Assigned(defTypesNode));
defSchemaNode := defTypesNode.FirstChild as TDOMElement;
s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
cplxNode := CreateElement(s,defSchemaNode,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.

98
wst/tags/0.5/same_process_protocol.pas Normal file
View File

@ -0,0 +1,98 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit same_process_protocol;
interface
uses
Classes, SysUtils,
service_intf, imp_utils,
server_service_intf, server_service_imputils, base_service_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Const
sTRANSPORT_NAME = 'SAME_PROCESS';
Type
{$M+}
{ TInProcessTransport }
TInProcessTransport = class(TSimpleFactoryItem,ITransport)
Private
FAdress: string;
FContentType: string;
FFormat : 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;
property Format : string read FFormat write FFormat;
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,Format);
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.

24563
wst/tags/0.5/samples/amazon/AWSECommerceService.pas Normal file
View File

File diff suppressed because it is too large Load Diff

607
wst/tags/0.5/samples/amazon/AWSECommerceService_proxy.pas Normal file
View File

@ -0,0 +1,607 @@
{
This unit has been produced by ws_helper.
Input unit name : "AWSECommerceService".
This unit name : "AWSECommerceService_proxy".
Date : "12/08/2007 22:38:58".
}
Unit AWSECommerceService_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, AWSECommerceService;
Type
TAWSECommerceServicePortType_Proxy=class(TBaseProxy,AWSECommerceServicePortType)
Protected
class function GetServiceType() : PTypeInfo;override;
function Help(
const HelpParam : Help_Type
):HelpResponse_Type;
function ItemSearch(
const ItemSearchParam : ItemSearch_Type
):ItemSearchResponse_Type;
function ItemLookup(
const ItemLookupParam : ItemLookup_Type
):ItemLookupResponse_Type;
function BrowseNodeLookup(
const BrowseNodeLookupParam : BrowseNodeLookup_Type
):BrowseNodeLookupResponse_Type;
function ListSearch(
const ListSearchParam : ListSearch_Type
):ListSearchResponse_Type;
function ListLookup(
const ListLookupParam : ListLookup_Type
):ListLookupResponse_Type;
function CustomerContentSearch(
const CustomerContentSearchParam : CustomerContentSearch_Type
):CustomerContentSearchResponse_Type;
function CustomerContentLookup(
const CustomerContentLookupParam : CustomerContentLookup_Type
):CustomerContentLookupResponse_Type;
function SimilarityLookup(
const SimilarityLookupParam : SimilarityLookup_Type
):SimilarityLookupResponse_Type;
function SellerLookup(
const SellerLookupParam : SellerLookup_Type
):SellerLookupResponse_Type;
function CartGet(
const CartGetParam : CartGet_Type
):CartGetResponse_Type;
function CartAdd(
const CartAddParam : CartAdd_Type
):CartAddResponse_Type;
function CartCreate(
const CartCreateParam : CartCreate_Type
):CartCreateResponse_Type;
function CartModify(
const CartModifyParam : CartModify_Type
):CartModifyResponse_Type;
function CartClear(
const CartClearParam : CartClear_Type
):CartClearResponse_Type;
function TransactionLookup(
const TransactionLookupParam : TransactionLookup_Type
):TransactionLookupResponse_Type;
function SellerListingSearch(
const SellerListingSearchParam : SellerListingSearch_Type
):SellerListingSearchResponse_Type;
function SellerListingLookup(
const SellerListingLookupParam : SellerListingLookup_Type
):SellerListingLookupResponse_Type;
function TagLookup(
const TagLookupParam : TagLookup_Type
):TagLookupResponse_Type;
function MultiOperation(
const MultiOperationParam : MultiOperation_Type
):MultiOperationResponse;
End;
Function wst_CreateInstance_AWSECommerceServicePortType(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'):AWSECommerceServicePortType;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_AWSECommerceServicePortType(const AFormat : string; const ATransport : string):AWSECommerceServicePortType;
Begin
Result := TAWSECommerceServicePortType_Proxy.Create('AWSECommerceServicePortType',AFormat+GetServiceDefaultFormatProperties(TypeInfo(AWSECommerceServicePortType)),ATransport + 'address=' + GetServiceDefaultAddress(TypeInfo(AWSECommerceServicePortType)));
End;
{ TAWSECommerceServicePortType_Proxy implementation }
class function TAWSECommerceServicePortType_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(AWSECommerceServicePortType);
end;
function TAWSECommerceServicePortType_Proxy.Help(
const HelpParam : Help_Type
):HelpResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Help', GetTarget(),(Self as ICallContext));
locSerializer.Put('Help', TypeInfo(Help_Type), HelpParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'HelpResponse';
locSerializer.Get(TypeInfo(HelpResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.ItemSearch(
const ItemSearchParam : ItemSearch_Type
):ItemSearchResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('ItemSearch', GetTarget(),(Self as ICallContext));
locSerializer.Put('ItemSearch', TypeInfo(ItemSearch_Type), ItemSearchParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'ItemSearchResponse';
locSerializer.Get(TypeInfo(ItemSearchResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.ItemLookup(
const ItemLookupParam : ItemLookup_Type
):ItemLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('ItemLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('ItemLookup', TypeInfo(ItemLookup_Type), ItemLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'ItemLookupResponse';
locSerializer.Get(TypeInfo(ItemLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.BrowseNodeLookup(
const BrowseNodeLookupParam : BrowseNodeLookup_Type
):BrowseNodeLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('BrowseNodeLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('BrowseNodeLookup', TypeInfo(BrowseNodeLookup_Type), BrowseNodeLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'BrowseNodeLookupResponse';
locSerializer.Get(TypeInfo(BrowseNodeLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.ListSearch(
const ListSearchParam : ListSearch_Type
):ListSearchResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('ListSearch', GetTarget(),(Self as ICallContext));
locSerializer.Put('ListSearch', TypeInfo(ListSearch_Type), ListSearchParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'ListSearchResponse';
locSerializer.Get(TypeInfo(ListSearchResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.ListLookup(
const ListLookupParam : ListLookup_Type
):ListLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('ListLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('ListLookup', TypeInfo(ListLookup_Type), ListLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'ListLookupResponse';
locSerializer.Get(TypeInfo(ListLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CustomerContentSearch(
const CustomerContentSearchParam : CustomerContentSearch_Type
):CustomerContentSearchResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CustomerContentSearch', GetTarget(),(Self as ICallContext));
locSerializer.Put('CustomerContentSearch', TypeInfo(CustomerContentSearch_Type), CustomerContentSearchParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CustomerContentSearchResponse';
locSerializer.Get(TypeInfo(CustomerContentSearchResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CustomerContentLookup(
const CustomerContentLookupParam : CustomerContentLookup_Type
):CustomerContentLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CustomerContentLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('CustomerContentLookup', TypeInfo(CustomerContentLookup_Type), CustomerContentLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CustomerContentLookupResponse';
locSerializer.Get(TypeInfo(CustomerContentLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.SimilarityLookup(
const SimilarityLookupParam : SimilarityLookup_Type
):SimilarityLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('SimilarityLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('SimilarityLookup', TypeInfo(SimilarityLookup_Type), SimilarityLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'SimilarityLookupResponse';
locSerializer.Get(TypeInfo(SimilarityLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.SellerLookup(
const SellerLookupParam : SellerLookup_Type
):SellerLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('SellerLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('SellerLookup', TypeInfo(SellerLookup_Type), SellerLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'SellerLookupResponse';
locSerializer.Get(TypeInfo(SellerLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CartGet(
const CartGetParam : CartGet_Type
):CartGetResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CartGet', GetTarget(),(Self as ICallContext));
locSerializer.Put('CartGet', TypeInfo(CartGet_Type), CartGetParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CartGetResponse';
locSerializer.Get(TypeInfo(CartGetResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CartAdd(
const CartAddParam : CartAdd_Type
):CartAddResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CartAdd', GetTarget(),(Self as ICallContext));
locSerializer.Put('CartAdd', TypeInfo(CartAdd_Type), CartAddParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CartAddResponse';
locSerializer.Get(TypeInfo(CartAddResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CartCreate(
const CartCreateParam : CartCreate_Type
):CartCreateResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CartCreate', GetTarget(),(Self as ICallContext));
locSerializer.Put('CartCreate', TypeInfo(CartCreate_Type), CartCreateParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CartCreateResponse';
locSerializer.Get(TypeInfo(CartCreateResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CartModify(
const CartModifyParam : CartModify_Type
):CartModifyResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CartModify', GetTarget(),(Self as ICallContext));
locSerializer.Put('CartModify', TypeInfo(CartModify_Type), CartModifyParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CartModifyResponse';
locSerializer.Get(TypeInfo(CartModifyResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.CartClear(
const CartClearParam : CartClear_Type
):CartClearResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('CartClear', GetTarget(),(Self as ICallContext));
locSerializer.Put('CartClear', TypeInfo(CartClear_Type), CartClearParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'CartClearResponse';
locSerializer.Get(TypeInfo(CartClearResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.TransactionLookup(
const TransactionLookupParam : TransactionLookup_Type
):TransactionLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('TransactionLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('TransactionLookup', TypeInfo(TransactionLookup_Type), TransactionLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'TransactionLookupResponse';
locSerializer.Get(TypeInfo(TransactionLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.SellerListingSearch(
const SellerListingSearchParam : SellerListingSearch_Type
):SellerListingSearchResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('SellerListingSearch', GetTarget(),(Self as ICallContext));
locSerializer.Put('SellerListingSearch', TypeInfo(SellerListingSearch_Type), SellerListingSearchParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'SellerListingSearchResponse';
locSerializer.Get(TypeInfo(SellerListingSearchResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.SellerListingLookup(
const SellerListingLookupParam : SellerListingLookup_Type
):SellerListingLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('SellerListingLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('SellerListingLookup', TypeInfo(SellerListingLookup_Type), SellerListingLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'SellerListingLookupResponse';
locSerializer.Get(TypeInfo(SellerListingLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.TagLookup(
const TagLookupParam : TagLookup_Type
):TagLookupResponse_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('TagLookup', GetTarget(),(Self as ICallContext));
locSerializer.Put('TagLookup', TypeInfo(TagLookup_Type), TagLookupParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'TagLookupResponse';
locSerializer.Get(TypeInfo(TagLookupResponse_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TAWSECommerceServicePortType_Proxy.MultiOperation(
const MultiOperationParam : MultiOperation_Type
):MultiOperationResponse;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('MultiOperation', GetTarget(),(Self as ICallContext));
locSerializer.Put('MultiOperation', TypeInfo(MultiOperation_Type), MultiOperationParam);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'MultiOperationResponse';
locSerializer.Get(TypeInfo(MultiOperationResponse), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i AWSECommerceService.wst}
{$IF DECLARED(Register_AWSECommerceService_ServiceMetadata)}
Register_AWSECommerceService_ServiceMetadata();
{$IFEND}
End.

152
wst/tags/0.5/samples/amazon/amazon_sample.lpi Normal file
View File

@ -0,0 +1,152 @@
<?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>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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>
<Units Count="7">
<Unit0>
<Filename Value="amazon_sample.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="amazon_sample"/>
<CursorPos X="40" Y="12"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<UnitName Value="synapse_http_protocol"/>
<CursorPos X="1" Y="16"/>
<TopLine Value="2"/>
<EditorIndex Value="5"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="AWSECommerceService.pas"/>
<UnitName Value="AWSECommerceService"/>
<CursorPos X="72" Y="20731"/>
<TopLine Value="20710"/>
<EditorIndex Value="3"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="AWSECommerceService_proxy.pas"/>
<UnitName Value="AWSECommerceService_proxy"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\httpsend.pas"/>
<UnitName Value="httpsend"/>
<CursorPos X="27" Y="2"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="4148"/>
<TopLine Value="4118"/>
<EditorIndex Value="4"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="140"/>
<TopLine Value="114"/>
<EditorIndex Value="1"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit6>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="amazon_sample"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\..\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

97
wst/tags/0.5/samples/amazon/amazon_sample.pas Normal file
View File

@ -0,0 +1,97 @@
program amazon_sample;
{$mode objfpc}{$H+}
uses
Classes, SysUtils,
soap_formatter,
synapse_http_protocol,
metadata_repository,
AWSECommerceService, AWSECommerceService_proxy;
const sACCES_ID = <your key here>;
function ReadEntry(const APromp : string):string ;
begin
Result := '';
Write(APromp);
while True do begin
ReadLn(Result);
Result := Trim(Result);
if ( Length(Result) > 0 ) then
Break;
end;
end;
var
locService : AWSECommerceServicePortType;
rqst : ItemSearch_Type;
rsps : ItemSearchResponse_Type;
rspsItem : Items_Type;
i, j, k : Integer;
itm : Item_Type;
begin
SYNAPSE_RegisterHTTP_Transport();
WriteLn('Web Services Toolkit Amazon sample');
WriteLn('This sample demonstrates the "ItemSearch" method of the Amazon web service');
WriteLn();
rqst := ItemSearch_Type.Create();
try
locService := wst_CreateInstance_AWSECommerceServicePortType();
rqst.AWSAccessKeyId := sACCES_ID;
while True do begin
rqst.Request.SetLength(1);
rqst.Request[0].SearchIndex := ReadEntry('Enter the Search Index : ');
rqst.Request[0].Availability := Available;
rqst.Request[0].Count := 10;
rqst.Request[0].MerchantId := 'Amazon';
rqst.Request[0].ItemPage := 1;
rqst.Request[0].Keywords := ReadEntry('Enter the Keywords : ');
rsps := locService.ItemSearch(rqst);
if ( rsps.OperationRequest.Errors.Length > 0 ) then begin
WriteLn(Format('Errors ( %d ) : ',[rsps.OperationRequest.Errors.Length]));
for i := 0 to Pred(rsps.OperationRequest.Errors.Length) do begin
WriteLn(Format(' Error[%d] :',[i]));
WriteLn(' ' + rsps.OperationRequest.Errors[i].Code);
WriteLn(' ' + rsps.OperationRequest.Errors[i].Message);
end;
end else begin
WriteLn(Format('Response ( %d ) : ',[rsps.Items.Length]));
if Assigned(rsps) then begin
for i := 0 to Pred(rsps.Items.Length) do begin
rspsItem := rsps.Items[i];
WriteLn(' TotalPages :' + IntToStr(rspsItem.TotalPages));
WriteLn(' TotalResults :' + IntToStr(rspsItem.TotalResults));
WriteLn(' Items :' + IntToStr(rspsItem._Item.Length));
WriteLn('');
for j := 0 to Pred(rspsItem._Item.Length) do begin
itm := rspsItem._Item[j];;
WriteLn(' ASIN :' + itm.ASIN);
WriteLn(' DetailPageURL :' + itm.DetailPageURL);
if Assigned(itm.ItemAttributes) then begin
WriteLn(' Title :' + itm.ItemAttributes.Title);
for k := 0 to Pred(itm.ItemAttributes.Author.Length) do begin
WriteLn(' Author[ ' + IntToStr(k) + ' ] ' + itm.ItemAttributes.Author.Item[k]);
end;
WriteLn(' Manufacturer :' + itm.ItemAttributes.Manufacturer);
WriteLn(' ProductGroup :' + itm.ItemAttributes.ProductGroup);
end;
WriteLn('');
end;
end;
end else begin
WriteLn('Unexpected service response : Invalid response');
end;
end;
WriteLn();
WriteLn();
if ( UpperCase(ReadEntry('Continue ( Y/N ) :'))[1] <> 'Y' ) then
Break;
end;
finally
FreeAndNil(rqst);
FreeAndNil(rsps);
end;
ReadLn;
end.

1
wst/tags/0.5/samples/amazon/parseWSDL.bat Normal file
View File

@ -0,0 +1 @@
..\..\ws_helper\ws_helper.exe -uA -p -o. AWSECommerceService.wsdl >parsing.res.txt

7
wst/tags/0.5/samples/apache_module/ReadMe.txt Normal file
View File

@ -0,0 +1,7 @@
Appache module configuration :
LoadModule wst_module modules/mod_wst.so
<Location /wst>
SetHandler wst-handler
</Location>

209
wst/tags/0.5/samples/apache_module/mod_wst.lpi Normal file
View File

@ -0,0 +1,209 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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>
<Units Count="14">
<Unit0>
<Filename Value="mod_wst.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mod_wst"/>
<CursorPos X="3" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="wst_apache_binding.pas"/>
<UnitName Value="wst_apache_binding"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="249"/>
<EditorIndex Value="4"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\metadata_wsdl.pas"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="70" Y="30"/>
<TopLine Value="16"/>
<EditorIndex Value="8"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="71" Y="20"/>
<TopLine Value="1"/>
<EditorIndex Value="9"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-1.3\httpd.pas"/>
<UnitName Value="httpd"/>
<CursorPos X="5" Y="26"/>
<TopLine Value="25"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-1.3\httpd.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="75"/>
<UsageCount Value="9"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\httpd.pas"/>
<UnitName Value="httpd"/>
<CursorPos X="35" Y="44"/>
<TopLine Value="61"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\http_protocol.inc"/>
<CursorPos X="47" Y="799"/>
<TopLine Value="777"/>
<EditorIndex Value="7"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\httpd.inc"/>
<CursorPos X="5" Y="794"/>
<TopLine Value="777"/>
<EditorIndex Value="6"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.0\apr\apr_tables.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="16"/>
<EditorIndex Value="5"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\http_config.inc"/>
<CursorPos X="71" Y="66"/>
<TopLine Value="32"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\httpd.pas"/>
<UnitName Value="httpd"/>
<CursorPos X="41" Y="134"/>
<TopLine Value="117"/>
<EditorIndex Value="2"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\ap_mmn.inc"/>
<CursorPos X="3" Y="111"/>
<TopLine Value="96"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.0\apr\apr_pools.inc"/>
<CursorPos X="3" Y="48"/>
<TopLine Value="678"/>
<UsageCount Value="10"/>
</Unit13>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="mod_wst.so"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apr\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apriconv\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\aprutil\"/>
<UnitOutputDirectory Value="obj"/>
<SrcPath Value="$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apr\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apriconv\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\aprutil\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="5">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
<Item5>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="176"/>
</Item5>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

52
wst/tags/0.5/samples/apache_module/mod_wst.lpr Normal file
View File

@ -0,0 +1,52 @@
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.

320
wst/tags/0.5/samples/apache_module/wst_apache_binding.pas Normal file
View File

@ -0,0 +1,320 @@
{$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,
user_service_intf, user_service_intf_binder, user_service_intf_imp,
metadata_service, metadata_service_binder, metadata_service_imp;
type
TRequestInfo = record
Root : string;
URI : string;
ContentType : string;
Buffer : string;
Argument : 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.Argument + LineEnding,'c:\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;
ARequestInfo.Argument := r^.args;
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();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
end.

43
wst/tags/0.5/samples/delphi/amazon/amazon_sample.cfg Normal file
View File

@ -0,0 +1,43 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-N"obj"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse"
-O"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse"
-I"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse"
-R"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

159
wst/tags/0.5/samples/delphi/amazon/amazon_sample.dof Normal file
View File

@ -0,0 +1,159 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=obj
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1036
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=7
Item0=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse
Item1=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\
Item2=..\..\;..\..\..\
Item3=..\..\
Item4=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item5=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item6=..\
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=obj

97
wst/tags/0.5/samples/delphi/amazon/amazon_sample.dpr Normal file
View File

@ -0,0 +1,97 @@
program amazon_sample;
{$APPTYPE CONSOLE}
uses
delphi_init_com,
Classes, SysUtils,
soap_formatter,
synapse_http_protocol,
metadata_repository,
AWSECommerceService, AWSECommerceService_proxy;
const sACCES_ID = <your key here>;
function ReadEntry(const APromp : string):string ;
begin
Result := '';
Write(APromp);
while True do begin
ReadLn(Result);
Result := Trim(Result);
if ( Length(Result) > 0 ) then
Break;
end;
end;
var
locService : AWSECommerceServicePortType;
rqst : ItemSearch_Type;
rsps : ItemSearchResponse_Type;
rspsItem : Items_Type;
i, j, k : Integer;
itm : Item_Type;
begin
SYNAPSE_RegisterHTTP_Transport();
WriteLn('Web Services Toolkit Amazon sample');
WriteLn('This sample demonstrates the "ItemSearch" method of the Amazon web service');
WriteLn;
rqst := ItemSearch_Type.Create();
try
locService := wst_CreateInstance_AWSECommerceServicePortType();
rqst.AWSAccessKeyId := sACCES_ID;
while True do begin
rqst.Request.SetLength(1);
rqst.Request[0].SearchIndex := ReadEntry('Enter the Search Index : ');
rqst.Request[0].Availability := Available;
rqst.Request[0].Count := 10;
rqst.Request[0].MerchantId := 'Amazon';
rqst.Request[0].ItemPage := 1;
rqst.Request[0].Keywords := ReadEntry('Enter the Keywords : ');
rsps := locService.ItemSearch(rqst);
if ( rsps.OperationRequest.Errors.Length > 0 ) then begin
WriteLn(Format('Errors ( %d ) : ',[rsps.OperationRequest.Errors.Length]));
for i := 0 to Pred(rsps.OperationRequest.Errors.Length) do begin
WriteLn(Format(' Error[%d] :',[i]));
WriteLn(' ' + rsps.OperationRequest.Errors[i].Code);
WriteLn(' ' + rsps.OperationRequest.Errors[i].Message);
end;
end else begin
WriteLn(Format('Response ( %d ) : ',[rsps.Items.Length]));
if Assigned(rsps) then begin
for i := 0 to Pred(rsps.Items.Length) do begin
rspsItem := rsps.Items[i];
WriteLn(' TotalPages :' + IntToStr(rspsItem.TotalPages));
WriteLn(' TotalResults :' + IntToStr(rspsItem.TotalResults));
WriteLn(' Items :' + IntToStr(rspsItem._Item.Length));
WriteLn('');
for j := 0 to Pred(rspsItem._Item.Length) do begin
itm := rspsItem._Item[j];;
WriteLn(' ASIN :' + itm.ASIN);
WriteLn(' DetailPageURL :' + itm.DetailPageURL);
if Assigned(itm.ItemAttributes) then begin
WriteLn(' Title :' + itm.ItemAttributes.Title);
for k := 0 to Pred(itm.ItemAttributes.Author.Length) do begin
WriteLn(' Author[ ' + IntToStr(k) + ' ] ' + itm.ItemAttributes.Author.Item[k]);
end;
WriteLn(' Manufacturer :' + itm.ItemAttributes.Manufacturer);
WriteLn(' ProductGroup :' + itm.ItemAttributes.ProductGroup);
end;
WriteLn('');
end;
end;
end else begin
WriteLn('Unexpected service response : Invalid response');
end;
end;
WriteLn;
WriteLn;
if ( UpperCase(ReadEntry('Continue ( Y/N ) :'))[1] <> 'Y' ) then
Break;
end;
finally
FreeAndNil(rqst);
FreeAndNil(rsps);
end;
ReadLn;
end.

44
wst/tags/0.5/samples/delphi/http_server/http_server.cfg Normal file
View File

@ -0,0 +1,44 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-N"obj"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"..\..\..\;..\..\;..\..\..\wst_rtti_filter"
-O"..\..\..\;..\..\;..\..\..\wst_rtti_filter"
-I"..\..\..\;..\..\;..\..\..\wst_rtti_filter"
-R"..\..\..\;..\..\;..\..\..\wst_rtti_filter"
-DINDY_9
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

159
wst/tags/0.5/samples/delphi/http_server/http_server.dof Normal file
View File

@ -0,0 +1,159 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=obj
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\..\;..\..\;..\..\..\wst_rtti_filter
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt
Conditionals=INDY_9
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1036
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.
[HistoryLists\hlConditionals]
Count=1
Item0=INDY_9
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=4
Item0=..\..\..\;..\..\;..\..\..\wst_rtti_filter
Item1=..\..\..\;..\..\
Item2=..\..\..\
Item3=..\
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=obj

49
wst/tags/0.5/samples/delphi/http_server/http_server.dpr Normal file
View File

@ -0,0 +1,49 @@
program http_server;
{$APPTYPE CONSOLE}
uses
SysUtils,
Classes,
ActiveX,
delphi_init_com in '..\..\..\delphi_init_com.pas',
server_service_soap,
server_binary_formatter,
server_service_xmlrpc,
indy_http_server,
metadata_service,
logger_extension,
wst_delphi_rtti_utils in '..\..\..\wst_delphi_rtti_utils.pas',
server_listener in '..\..\..\server_listener.pas',
config_objects in '..\..\..\config_objects.pas',
user_service_intf in '..\..\user_service_intf.pas',
user_service_intf_binder in '..\..\user_service_intf_binder.pas',
user_service_intf_imp in '..\..\user_service_intf_imp.pas',
server_service_intf in '..\..\..\server_service_intf.pas';
var
AppObject : TwstListener; AppObject2 : TwstListener;
begin
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
//wst_CreateDefaultFile(wst_GetConfigFileName(),nil);
AppObject := TwstIndyHttpListener.Create();
try
WriteLn('"Web Service Toolkit" HTTP Server sample listening at:');
WriteLn('');
WriteLn('http://127.0.0.1:8000/');
WriteLn('');
WriteLn('Press enter to quit.');
AppObject.Start();
ReadLn;
finally
FreeAndNil(AppObject);
end;
end.

43
wst/tags/0.5/samples/delphi/library_server/lib_server.cfg Normal file
View File

@ -0,0 +1,43 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-N"obj"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"..\..\;..\..\..\;..\..\..\wst_rtti_filter"
-O"..\..\;..\..\..\;..\..\..\wst_rtti_filter"
-I"..\..\;..\..\..\;..\..\..\wst_rtti_filter"
-R"..\..\;..\..\..\;..\..\..\wst_rtti_filter"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

161
wst/tags/0.5/samples/delphi/library_server/lib_server.dof Normal file
View File

@ -0,0 +1,161 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=obj
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\;..\..\..\;..\..\..\wst_rtti_filter
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1036
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.
[HistoryLists\hlConditionals]
Count=1
Item0=INDY_9
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=6
Item0=..\..\;..\..\..\;..\..\..\wst_rtti_filter
Item1=..\..\;..\..\..\
Item2=..\..\..\;..\..\;..\..\..\wst_rtti_filter
Item3=..\..\..\;..\..\
Item4=..\..\..\
Item5=..\
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=obj

36
wst/tags/0.5/samples/delphi/library_server/lib_server.dpr Normal file
View File

@ -0,0 +1,36 @@
library lib_server;
uses
SysUtils, Classes,
base_service_intf,
server_service_intf,
server_service_soap,
server_binary_formatter,
server_service_xmlrpc,
metadata_repository,
metadata_wsdl,
metadata_service,
metadata_service_binder,
metadata_service_imp,
library_base_intf,
library_server_intf,
user_service_intf_binder,
user_service_intf_imp;
{$R *.res}
exports
wstHandleRequest name WST_LIB_HANDLER;
begin
RegisterStdTypes();
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
end.

44
wst/tags/0.5/samples/delphi/tcp_server/tcp_server.cfg Normal file
View File

@ -0,0 +1,44 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-N"obj"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter"
-O"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter"
-I"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter"
-R"..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter"
-DINDY_9
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

163
wst/tags/0.5/samples/delphi/tcp_server/tcp_server.dof Normal file
View File

@ -0,0 +1,163 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=obj
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt
Conditionals=INDY_9
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1036
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.
[HistoryLists\hlConditionals]
Count=1
Item0=INDY_9
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=8
Item0=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\wst_rtti_filter
Item1=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\wst_rtti_filter
Item2=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse
Item3=..\..\;..\..\..\
Item4=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item5=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item6=..\..\
Item7=..\
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=obj

52
wst/tags/0.5/samples/delphi/tcp_server/tcp_server.dpr Normal file
View File

@ -0,0 +1,52 @@
program tcp_server;
{$APPTYPE CONSOLE}
uses
Classes,
SysUtils, ActiveX,
base_service_intf,
server_service_soap,
base_binary_formatter,
server_binary_formatter,
metadata_service,
metadata_service_imp,
metadata_service_binder,
//synapse_tcp_server,
indy_tcp_server,
user_service_intf,
user_service_intf_binder,
user_service_intf_imp,
imp_helper,
server_service_xmlrpc,
server_listener;
{$INCLUDE wst.inc}
var
listener : TwstListener;
begin
CoInitialize(nil);
try
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterWSTMetadataServiceImplementationFactory();
//Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
WriteLn(Format('WST sample TCP Server listning on "%d"',[sSERVER_PORT]));
WriteLn('Hit <enter> to stop.');
//listener := TwstSynapseTcpListener.Create();
listener := TwstIndyTcpListener.Create();
listener.Start();
ReadLn;
finally
CoUninitialize();
end;
end.

43
wst/tags/0.5/samples/delphi/user_client_console/user_client_console.cfg Normal file
View File

@ -0,0 +1,43 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-N"obj"
-LE"c:\program files\borland\delphi7\Projects\Bpl"
-LN"c:\program files\borland\delphi7\Projects\Bpl"
-U"c:\program files\borland\delphi7\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\"
-O"c:\program files\borland\delphi7\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\"
-I"c:\program files\borland\delphi7\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\"
-R"c:\program files\borland\delphi7\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

158
wst/tags/0.5/samples/delphi/user_client_console/user_client_console.dof Normal file
View File

@ -0,0 +1,158 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=obj
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;FIBDBMidas7;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;dxForumLibD7;cxLibraryVCLD7;cxPageControlVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtItemsD7;dxBarExtDBItemsD7;dxsbD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxEdtrD7;EQTLD7;ECQDBCD7;EQDBTLD7;EQGridD7;dxGrEdD7;dxExELD7;dxELibD7;cxEditorsVCLD7;cxGridVCLD7;dxThemeD7;cxDataD7;cxGridUtilsVCLD7;dxPSCoreD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSTeeChartD7;dxPSDBTeeChartD7;dxPSdxDBTVLnkD7;dxPSdxOCLnkD7;dxPSdxDBOCLnkD7;dxPScxGridLnkD7;dxPSTLLnkD7;qrpt
Conditionals=
DebugSourceDirs=C:\Programmes\lazarus\wst\trunk\
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1036
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc.
C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc.
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=6
Item0=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item1=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse;..\..\..\..\
Item2=..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\synapse
Item3=..\..\;..\..\..\
Item4=..\..\
Item5=..\
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=obj

274
wst/tags/0.5/samples/delphi/user_client_console/user_client_console.dpr Normal file
View File

@ -0,0 +1,274 @@
program user_client_console;
{$APPTYPE CONSOLE}
uses
Classes,
SysUtils,
TypInfo, ActiveX,
user_service_intf_proxy,
synapse_tcp_protocol,
synapse_http_protocol,
library_protocol,
binary_formatter,
base_soap_formatter, soap_formatter,
base_xmlrpc_formatter, xmlrpc_formatter,
user_service_intf,
wst_delphi_xml in '..\..\..\wst_delphi_xml.pas';
{$INCLUDE wst.inc}
type
TUser = TUser_Type;
TUserCategory = TUserCategory_Type;
var
UserServiceInst : UserService;
procedure ShowUser(AUser : TUser);
begin
if ( AUser <> nil ) then begin
WriteLn(' Name = ',AUser.UserName);
WriteLn(' Category = ',GetEnumName(TypeInfo(TUserCategory),Ord(AUser.Category)));
WriteLn(' e-Mail = ',AUser.eMail);
WriteLn(' Preferences = ',AUser.Preferences);
end else begin
WriteLn('<Empty User>');
end;
end;
procedure ShowUserArray(AArray : TUserArray);
var
i, c : Integer;
usr : TUser;
begin
if ( AArray <> nil ) then begin
c := AArray.Length;
for i := 0 to Pred(c) do begin
usr := AArray[i];
WriteLn;
WriteLn(Format('User[%d] : ',[(i+1)]));
ShowUser(usr);
end;
end;
end;
procedure HandleShowAll();
var
userArray : TUserArray;
begin
userArray := UserServiceInst.GetList();
try
if ( userArray <> nil ) and ( userArray.Length > 0 ) then begin
ShowUserArray(userArray);
end else begin
WriteLn('Empty Array.');
end;
finally
FreeAndNil(userArray);
end;
end;
type TAddType = ( atAdd, atUpdate );
procedure HandleAdd(const AType :TAddType);
const CAPTIONS : array[TAddType] of string = ( 'Adding a user :', 'Updating a user :' );
function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
begin
Result := '';
Write(APrompt);
ReadLn(Result);
Result := Trim(Result);
if ANonNull and ( Length(Result) = 0 ) then
Raise Exception.Create('Invalid User Name!');
end;
var
usr : TUser;
buff : string;
begin
buff := '';
WriteLn(CAPTIONS[AType]);
try
usr := TUser.Create();
try
usr.UserName := ReadItem('Enter user name : ',True);
buff := UpperCase(ReadItem('Enter user Category( A : Admin; N : normal ) : ',True));
if ( buff[1] = 'A' ) then
usr.Category:= Admin
else
usr.Category:= Normal;
usr.eMail := ReadItem('Enter user e-mail : ',False);
usr.Preferences := ReadItem('Enter user Preferences : ',False);
if ( AType = atUpdate ) then
UserServiceInst.Update(usr)
else
UserServiceInst.Add(usr);
finally
FreeAndNil(usr);
end;
except
on e : Exception do begin
WriteLn(e.Message);
end;
end;
end;
procedure HandleFindUser();
var
user : TUser;
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
user := UserServiceInst.Find(buff);
try
ShowUser(user);
finally
FreeAndNil(user);
end;
end;
procedure HandleDeleteUser();
var
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
UserServiceInst.Delete(buff);
end;
type
TTransportType = ( ttLibrary, ttTCP, ttHTTP );
TFormatType = ( ftBinary, ftSoap, ftXmlRPC );
var
TransportType : TTransportType;
FormatValue : TFormatType;
procedure CreateProxy();
const ADDRESS_MAP : array[TTransportType] of string = (
'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
'TCP:Address=127.0.0.1;Port=1234;target=UserService',
//'http:Address=http://127.0.0.1:8080/wst/services/UserService/?format=soap'
'http:Address=http://127.0.0.1:8000/services/UserService'
);
FORMAT_MAP : array[TFormatType] of string = ( 'binary', 'soap', 'xmlrpc' );
var
buff : string;
begin
if ( TransportType = ttHTTP ) then
buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
else
buff := ADDRESS_MAP[TransportType];
if ( TransportType = ttLibrary ) then
buff := StringReplace(buff,'\',PathDelim,[rfReplaceAll, rfIgnoreCase]);
UserServiceInst := TUserService_Proxy.Create(
'UserService',
FORMAT_MAP[FormatValue] + ':',
buff
);
end;
procedure ReadTransportType();
var
buff : string;
begin
WriteLn;
WriteLn('Select a transport protocol : ');
WriteLn(' L : Library, the lib_server project must have been built');
WriteLn(' T : TCP, the tcp_server must have been built');
WriteLn(' H : HTTP, the http_server must have been built');
WriteLn;
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
case buff[1] of
'L' : TransportType := ttLibrary;
'T' : TransportType := ttTCP;
'H' : TransportType := ttHTTP;
end;
Break;
end;
end;
end;
procedure ReadFormatType();
var
buff : string;
begin
WriteLn;
WriteLn('Select a messaging format : ');
WriteLn(' B : binary ( binary_formatter.pas )');
WriteLn(' S : soap ( soap_formatter.pas )');
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
WriteLn;
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['B','S', 'X'] ) then begin
case buff[1] of
'B' : FormatValue := ftBinary;
'S' : FormatValue := ftSoap;
'X' : FormatValue := ftXmlRPC;
end;
Break;
end;
end;
end;
var
strBuffer : string;
begin
CoInitialize(nil);
try
SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport();
WriteLn('Sample Application using Web Services Toolkit');
ReadFormatType();
ReadTransportType();
CreateProxy();
WriteLn('Menu :');
WriteLn(' L : Show the user list');
WriteLn(' A : Add a new user');
WriteLn(' U : Update a user');
WriteLn(' D : Delete a user');
WriteLn(' F : Find a new');
WriteLn(' C : Change the communication protocol');
WriteLn(' Z : Change the messaging format');
WriteLn(' X : Exit');
WriteLn;
Write('Choose a item : ');
while True do begin
strBuffer := '';
ReadLn(strBuffer);
strBuffer := UpperCase(Trim(strBuffer));
if ( Length(strBuffer) > 0 ) then begin
case strBuffer[1] of
'L' : HandleShowAll();
'A' : HandleAdd(atAdd);
'U' : HandleAdd(atUpdate);
'D' : HandleDeleteUser();
'F' : HandleFindUser();
'C' :
begin
ReadTransportType();
CreateProxy();
end;
'Z' :
begin
ReadFormatType();
CreateProxy();
end;
'X' : Break;
end;
WriteLn;
Write('Choose a item : ');
end;
end;
finally
CoUninitialize();
end;
end.

1
wst/tags/0.5/samples/extract_binder.bat Normal file
View File

@ -0,0 +1 @@
..\..\wst\ws_helper\ws_helper -b -o. "user_service_intf.wsdl" >extract_bind.res.txt

1
wst/tags/0.5/samples/extract_imp.bat Normal file
View File

@ -0,0 +1 @@
..\..\wst\ws_helper\ws_helper -i -o. "user_service_intf.wsdl" >extract_imp.res.txt

1
wst/tags/0.5/samples/extract_intf.bat Normal file
View File

@ -0,0 +1 @@
..\ws_helper\ws_helper -uA -p -o. "user_service_intf.wsdl" >extract_intf.res.txt

1
wst/tags/0.5/samples/extract_proxy.bat Normal file
View File

@ -0,0 +1 @@
..\..\wst\ws_helper\ws_helper -p -o. "user_service_intf.wsdl" >extract_proxy.res.txt

641
wst/tags/0.5/samples/http_server/http_server.lpi Normal file
View File

@ -0,0 +1,641 @@
<?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="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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="72">
<Unit0>
<Filename Value="http_server.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="http_server"/>
<CursorPos X="38" Y="7"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="132"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="app_object.pas"/>
<UnitName Value="app_object"/>
<CursorPos X="42" Y="214"/>
<TopLine Value="200"/>
<UsageCount Value="30"/>
</Unit1>
<Unit2>
<Filename Value="../../base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="63"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../metadata_wsdl.pas"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="80" Y="80"/>
<TopLine Value="66"/>
<EditorIndex Value="9"/>
<UsageCount Value="64"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../metadata_service_imp.pas"/>
<UnitName Value="metadata_service_imp"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="31"/>
</Unit4>
<Unit5>
<Filename Value="../user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="60" Y="51"/>
<TopLine Value="32"/>
<EditorIndex Value="6"/>
<UsageCount Value="61"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="../user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="37" Y="247"/>
<TopLine Value="224"/>
<EditorIndex Value="4"/>
<UsageCount Value="47"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../user_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="7" Y="3"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<UsageCount Value="83"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="../../metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="7"/>
<EditorIndex Value="10"/>
<UsageCount Value="64"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="../../semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="140"/>
<TopLine Value="113"/>
<UsageCount Value="25"/>
</Unit9>
<Unit10>
<Filename Value="../../server_service_intf.pas"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="63"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="../../server_service_soap.pas"/>
<UnitName Value="server_service_soap"/>
<CursorPos X="17" Y="22"/>
<TopLine Value="1"/>
<UsageCount Value="39"/>
</Unit11>
<Unit12>
<Filename Value="../../base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="36" Y="1576"/>
<TopLine Value="1586"/>
<UsageCount Value="40"/>
</Unit12>
<Unit13>
<Filename Value="../../server_service_imputils.pas"/>
<UnitName Value="server_service_imputils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="34"/>
</Unit13>
<Unit14>
<Filename Value="../../../../../../lazarus_23_215/others_package/indy/indy-10.2.0.1/fpc/Protocols/IdCustomHTTPServer.pas"/>
<UnitName Value="IdCustomHTTPServer"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="1"/>
</Unit14>
<Unit15>
<Filename Value="../../../../../../lazarus23_213/fpc/2.1.3/source/rtl/i386/i386.inc"/>
<CursorPos X="49" Y="1252"/>
<TopLine Value="1231"/>
<UsageCount Value="1"/>
</Unit15>
<Unit16>
<Filename Value="../../wst.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<Filename Value="../../xmlrpc_formatter.pas"/>
<UnitName Value="xmlrpc_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="28"/>
<UsageCount Value="1"/>
</Unit17>
<Unit18>
<Filename Value="../../server_service_xmlrpc.pas"/>
<UnitName Value="server_service_xmlrpc"/>
<CursorPos X="21" Y="22"/>
<TopLine Value="7"/>
<UsageCount Value="37"/>
</Unit18>
<Unit19>
<Filename Value="../../server_binary_formatter.pas"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="35"/>
</Unit19>
<Unit20>
<Filename Value="../../base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="3" Y="985"/>
<TopLine Value="974"/>
<UsageCount Value="35"/>
</Unit20>
<Unit21>
<Filename Value="../../../../../../lazarus23_213/others_package/indy/indy-10.2.0.1/fpc/Core/IdSocketHandle.pas"/>
<UnitName Value="IdSocketHandle"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="1"/>
</Unit21>
<Unit22>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/lazarus/IdAboutVCL.pas"/>
<UnitName Value="IdAboutVCL"/>
<CursorPos X="19" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
</Unit22>
<Unit23>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/System/IdGlobal.pas"/>
<UnitName Value="IdGlobal"/>
<CursorPos X="14" Y="510"/>
<TopLine Value="497"/>
<UsageCount Value="13"/>
</Unit23>
<Unit24>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/systemh.inc"/>
<CursorPos X="21" Y="208"/>
<TopLine Value="193"/>
<UsageCount Value="44"/>
</Unit24>
<Unit25>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/innr.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="42"/>
<UsageCount Value="2"/>
</Unit25>
<Unit26>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/i386/fastmove.inc"/>
<CursorPos X="11" Y="835"/>
<TopLine Value="821"/>
<UsageCount Value="3"/>
</Unit26>
<Unit27>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/system.inc"/>
<CursorPos X="11" Y="306"/>
<TopLine Value="285"/>
<UsageCount Value="36"/>
</Unit27>
<Unit28>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/generic.inc"/>
<CursorPos X="5" Y="1289"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit28>
<Unit29>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/system.fpd"/>
<CursorPos X="22" Y="17"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
</Unit29>
<Unit30>
<Filename Value="../../wst_fpc_xml.pas"/>
<UnitName Value="wst_fpc_xml"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="35"/>
</Unit30>
<Unit31>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/objpas/sysutils/sysstrh.inc"/>
<CursorPos X="11" Y="66"/>
<TopLine Value="52"/>
<UsageCount Value="35"/>
</Unit31>
<Unit32>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/objpas/sysutils/sysstr.inc"/>
<CursorPos X="6" Y="44"/>
<TopLine Value="30"/>
<UsageCount Value="2"/>
</Unit32>
<Unit33>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/win/sysosh.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="51"/>
<UsageCount Value="2"/>
</Unit33>
<Unit34>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/objpash.inc"/>
<CursorPos X="25" Y="216"/>
<TopLine Value="203"/>
<UsageCount Value="7"/>
</Unit34>
<Unit35>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/varianth.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
</Unit35>
<Unit36>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/rtti.inc"/>
<CursorPos X="59" Y="101"/>
<TopLine Value="101"/>
<UsageCount Value="51"/>
</Unit36>
<Unit37>
<Filename Value="../../metadata_service.pas"/>
<UnitName Value="metadata_service"/>
<CursorPos X="26" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="31"/>
</Unit37>
<Unit38>
<Filename Value="../../wst_rtti_filter/cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="20"/>
</Unit38>
<Unit39>
<Filename Value="../user_service_intf.wst"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
<SyntaxHighlighter Value="None"/>
</Unit39>
<Unit40>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/packages/fcl-xml/src/dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="42" Y="228"/>
<TopLine Value="215"/>
<UsageCount Value="11"/>
</Unit40>
<Unit41>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/objpas/typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="115"/>
<UsageCount Value="45"/>
</Unit41>
<Unit42>
<Filename Value="../user_service_intf_proxy.pas"/>
<UnitName Value="user_service_intf_proxy"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="28"/>
</Unit42>
<Unit43>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Protocols/IdCustomHTTPServer.pas"/>
<UnitName Value="IdCustomHTTPServer"/>
<CursorPos X="14" Y="252"/>
<TopLine Value="239"/>
<UsageCount Value="5"/>
</Unit43>
<Unit44>
<Filename Value="../../type_lib_edtr/uabout.pas"/>
<ComponentName Value="fAbout"/>
<HasResources Value="True"/>
<ResourceFilename Value="../../type_lib_edtr/uabout.lrs"/>
<UnitName Value="uabout"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="5"/>
</Unit44>
<Unit45>
<Filename Value="../../type_lib_edtr/uwsttypelibraryedit.pas"/>
<ComponentName Value="fWstTypeLibraryEdit"/>
<HasResources Value="True"/>
<UnitName Value="uwsttypelibraryedit"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="4"/>
</Unit45>
<Unit46>
<Filename Value="../../ide/lazarus/wstimportdlg.pas"/>
<ComponentName Value="formImport"/>
<HasResources Value="True"/>
<ResourceFilename Value="../../ide/lazarus/wstimportdlg.lrs"/>
<UnitName Value="wstimportdlg"/>
<CursorPos X="27" Y="7"/>
<TopLine Value="1"/>
<UsageCount Value="5"/>
</Unit46>
<Unit47>
<Filename Value="../../indy_http_server.pas"/>
<UnitName Value="indy_http_server"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="38"/>
<Loaded Value="True"/>
</Unit47>
<Unit48>
<Filename Value="../../server_listener.pas"/>
<UnitName Value="server_listener"/>
<CursorPos X="28" Y="33"/>
<TopLine Value="26"/>
<UsageCount Value="20"/>
</Unit48>
<Unit49>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/aliases.inc"/>
<CursorPos X="84" Y="14"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit49>
<Unit50>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/inc/variant.inc"/>
<CursorPos X="11" Y="24"/>
<TopLine Value="29"/>
<UsageCount Value="10"/>
</Unit50>
<Unit51>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/objpas/sysutils/osutilsh.inc"/>
<CursorPos X="53" Y="37"/>
<TopLine Value="30"/>
<UsageCount Value="13"/>
</Unit51>
<Unit52>
<Filename Value="../../../../../../lazarus_23_215XX/fpc/source/rtl/win/sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="45" Y="1084"/>
<TopLine Value="1076"/>
<UsageCount Value="13"/>
</Unit52>
<Unit53>
<Filename Value="../../config_objects.pas"/>
<UnitName Value="config_objects"/>
<CursorPos X="74" Y="99"/>
<TopLine Value="85"/>
<EditorIndex Value="1"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit53>
<Unit54>
<Filename Value="../../wst_delphi.inc"/>
<CursorPos X="22" Y="5"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit54>
<Unit55>
<Filename Value="../../indy_tcp_server.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="indy_tcp_server"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit55>
<Unit56>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdTCPServer.pas"/>
<UnitName Value="IdTCPServer"/>
<CursorPos X="38" Y="32"/>
<TopLine Value="19"/>
<UsageCount Value="10"/>
</Unit56>
<Unit57>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdCustomTCPServer.pas"/>
<UnitName Value="IdCustomTCPServer"/>
<CursorPos X="74" Y="260"/>
<TopLine Value="238"/>
<UsageCount Value="14"/>
</Unit57>
<Unit58>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/System/IdSys.pas"/>
<UnitName Value="IdSys"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit58>
<Unit59>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdThread.pas"/>
<UnitName Value="IdThread"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit59>
<Unit60>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdYarn.pas"/>
<UnitName Value="IdYarn"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="21"/>
<UsageCount Value="9"/>
</Unit60>
<Unit61>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdTask.pas"/>
<UnitName Value="IdTask"/>
<CursorPos X="6" Y="32"/>
<TopLine Value="19"/>
<UsageCount Value="13"/>
</Unit61>
<Unit62>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdIOHandler.pas"/>
<UnitName Value="IdIOHandler"/>
<CursorPos X="3" Y="906"/>
<TopLine Value="902"/>
<UsageCount Value="10"/>
</Unit62>
<Unit63>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdBuffer.pas"/>
<UnitName Value="IdBuffer"/>
<CursorPos X="17" Y="432"/>
<TopLine Value="427"/>
<UsageCount Value="13"/>
</Unit63>
<Unit64>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdTCPConnection.pas"/>
<UnitName Value="IdTCPConnection"/>
<CursorPos X="15" Y="357"/>
<TopLine Value="340"/>
<UsageCount Value="13"/>
</Unit64>
<Unit65>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdIOHandlerSocket.pas"/>
<UnitName Value="IdIOHandlerSocket"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit65>
<Unit66>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdIOHandlerStack.pas"/>
<UnitName Value="IdIOHandlerStack"/>
<CursorPos X="3" Y="400"/>
<TopLine Value="438"/>
<UsageCount Value="13"/>
</Unit66>
<Unit67>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdExceptionCore.pas"/>
<UnitName Value="IdExceptionCore"/>
<CursorPos X="33" Y="108"/>
<TopLine Value="95"/>
<UsageCount Value="13"/>
</Unit67>
<Unit68>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/System/IdException.pas"/>
<UnitName Value="IdException"/>
<CursorPos X="3" Y="183"/>
<TopLine Value="160"/>
<UsageCount Value="9"/>
</Unit68>
<Unit69>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/System/IdObjs.pas"/>
<UnitName Value="IdObjs"/>
<CursorPos X="3" Y="94"/>
<TopLine Value="78"/>
<UsageCount Value="13"/>
</Unit69>
<Unit70>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/Core/IdSocketHandle.pas"/>
<UnitName Value="IdSocketHandle"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit70>
<Unit71>
<Filename Value="../../../../../../lazarus_23_215XX/others_package/indy/indy-10.2.0.1/fpc/System/IdStack.pas"/>
<UnitName Value="IdStack"/>
<CursorPos X="14" Y="200"/>
<TopLine Value="176"/>
<UsageCount Value="13"/>
</Unit71>
</Units>
<JumpHistory Count="3" HistoryIndex="2">
<Position1>
<Filename Value="http_server.pas"/>
<Caret Line="12" Column="56" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="../user_service_intf_imp.pas"/>
<Caret Line="51" Column="60" TopLine="32"/>
</Position2>
<Position3>
<Filename Value="../../config_objects.pas"/>
<Caret Line="99" Column="60" TopLine="76"/>
</Position3>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<Target>
<Filename Value="http_server"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../../;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Inc/"/>
<OtherUnitFiles Value="../;../../;../../wst_rtti_filter/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Core/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Protocols/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/System/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Inc/"/>
<UnitOutputDirectory Value="obj"/>
<SrcPath Value="$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Core/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Protocols/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/System/;$(LazarusDir)/others_package/indy/indy-10.2.0.1/fpc/Inc/"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-dINDY_10
-dUseCThreads
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

39
wst/tags/0.5/samples/http_server/http_server.pas Normal file
View File

@ -0,0 +1,39 @@
program http_server;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils,
indy_http_server, metadata_service, logger_extension, server_listener,
server_service_soap, server_binary_formatter, server_service_xmlrpc, config_objects,
user_service_intf, user_service_intf_binder, user_service_intf_imp;
var
AppObject : TwstListener;
begin
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
//wst_CreateDefaultFile(wst_GetConfigFileName(),nil);
AppObject := TwstIndyHttpListener.Create();
try
WriteLn('"Web Service Toolkit" HTTP Server sample listening at:');
WriteLn('');
WriteLn('http://127.0.0.1:8000/');
WriteLn('');
WriteLn('Press enter to quit.');
AppObject.Start();
ReadLn();
finally
FreeAndNil(AppObject);
end;
end.

76
wst/tags/0.5/samples/imp_helper.pas Normal file
View File

@ -0,0 +1,76 @@
{$INCLUDE wst_global.inc}
unit imp_helper;
interface
uses
Classes, SysUtils,
base_service_intf,
base_binary_formatter;
procedure SaveObjectToStream(AObject : TPersistent; AStream : TStream);
procedure LoadObjectFromStream(AObject : TPersistent; AStream : TStream);
procedure SaveObjectToFile(AObject : TPersistent; const AFileName : string);
procedure LoadObjectFromFile(AObject : TPersistent; const AFileName : string);
implementation
uses TypInfo;
procedure SaveObjectToFile(AObject : TPersistent; const AFileName : string);
var
strm : TFileStream;
begin
if FileExists(AFileName) then
DeleteFile(AFileName);
strm := TFileStream.Create(AFileName,fmCreate);
try
SaveObjectToStream(AObject,strm);
finally
strm.Free();
end;
end;
procedure LoadObjectFromFile(AObject : TPersistent; const AFileName : string);
var
strm : TFileStream;
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt('File not found : "%s"',[AFileName]);
strm := TFileStream.Create(AFileName,fmOpenRead);
try
LoadObjectFromStream(AObject,strm);
finally
strm.Free();
end;
end;
procedure SaveObjectToStream(AObject : TPersistent; AStream : TStream);
var
srlzr : IFormatterBase;
begin
srlzr := TBaseBinaryFormatter.Create();
srlzr.BeginObject('root',TypeInfo(TPersistent));
srlzr.Put('object',PTypeInfo(AObject.ClassInfo),AObject);
srlzr.EndScope();
srlzr.SaveToStream(AStream);
end;
procedure LoadObjectFromStream(AObject : TPersistent; AStream : TStream);
var
srlzr : IFormatterBase;
nme : string;
begin
srlzr := TBaseBinaryFormatter.Create();
srlzr.LoadFromStream(AStream);
nme := 'root';
srlzr.BeginObjectRead(nme,TypeInfo(TPersistent));
nme := 'object';
srlzr.Get(PTypeInfo(AObject.ClassInfo),nme,AObject);
srlzr.EndScopeRead();
end;
end.

180
wst/tags/0.5/samples/library_server/lib_server.lpi Normal file
View File

@ -0,0 +1,180 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="4"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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>
<Units Count="9">
<Unit0>
<Filename Value="lib_server.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="lib_server"/>
<CursorPos X="49" Y="35"/>
<TopLine Value="7"/>
<EditorIndex Value="0"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../../library_server_intf.pas"/>
<UnitName Value="library_server_intf"/>
<CursorPos X="32" Y="91"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="43" Y="179"/>
<TopLine Value="157"/>
<EditorIndex Value="6"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../wst_rtti_filter/rtti_filters.pas"/>
<UnitName Value="rtti_filters"/>
<CursorPos X="53" Y="43"/>
<TopLine Value="184"/>
<EditorIndex Value="8"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="64"/>
<EditorIndex Value="1"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="52" Y="4125"/>
<TopLine Value="4118"/>
<EditorIndex Value="7"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="../../semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="140"/>
<TopLine Value="116"/>
<EditorIndex Value="4"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../wst_rtti_filter/cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="2" Y="13"/>
<TopLine Value="34"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="../../../../lazarus/lazarus/others_package/indy/indy-10.2.0.1/lazarus/IdDsnCoreResourceStrings.pas"/>
<UnitName Value="IdDsnCoreResourceStrings"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit8>
</Units>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="../../semaphore.pas"/>
<Caret Line="140" Column="1" TopLine="113"/>
</Position1>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<Target>
<Filename Value="lib_server.dll"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../../"/>
<OtherUnitFiles Value="../;../../;../../wst_rtti_filter/"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

46
wst/tags/0.5/samples/library_server/lib_server.lpr Normal file
View File

@ -0,0 +1,46 @@
{
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.
}
library lib_server;
{$mode objfpc}{$H+}
uses
SysUtils, Classes,
base_service_intf,
server_service_intf,
server_service_soap, server_binary_formatter, server_service_xmlrpc,
metadata_repository, metadata_wsdl,
metadata_service, metadata_service_binder, metadata_service_imp,
library_base_intf, library_server_intf,
user_service_intf_binder, user_service_intf_imp;
exports
wstHandleRequest name WST_LIB_HANDLER;
begin
RegisterStdTypes();
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
end.

83
wst/tags/0.5/samples/logger_extension.pas Normal file
View File

@ -0,0 +1,83 @@
{
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.
}
{$INCLUDE wst_global.inc}
unit logger_extension;
interface
uses
Classes, SysUtils, base_service_intf, server_service_intf;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
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.

537
wst/tags/0.5/samples/tcp_server/tcp_server.lpi Normal file
View File

@ -0,0 +1,537 @@
<?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="10"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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>
<Units Count="60">
<Unit0>
<Filename Value="tcp_server.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tcp_server"/>
<CursorPos X="22" Y="37"/>
<TopLine Value="27"/>
<EditorIndex Value="0"/>
<UsageCount Value="89"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="synapse_tcp_server.pas"/>
<UnitName Value="synapse_tcp_server"/>
<CursorPos X="42" Y="211"/>
<TopLine Value="197"/>
<UsageCount Value="64"/>
</Unit1>
<Unit2>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="26" Y="686"/>
<TopLine Value="672"/>
<UsageCount Value="8"/>
</Unit2>
<Unit3>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\sysosh.inc"/>
<CursorPos X="3" Y="25"/>
<TopLine Value="4"/>
<UsageCount Value="5"/>
</Unit3>
<Unit4>
<Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2395"/>
<UsageCount Value="8"/>
</Unit4>
<Unit5>
<Filename Value="..\..\binary_streamer.pas"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="37" Y="13"/>
<TopLine Value="178"/>
<UsageCount Value="7"/>
</Unit5>
<Unit6>
<Filename Value="..\..\server_service_soap.pas"/>
<UnitName Value="server_service_soap"/>
<CursorPos X="33" Y="21"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="31"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\..\server_binary_formatter.pas"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="24" Y="22"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="..\..\metadata_service.pas"/>
<UnitName Value="metadata_service"/>
<CursorPos X="11" Y="121"/>
<TopLine Value="99"/>
<UsageCount Value="12"/>
</Unit8>
<Unit9>
<Filename Value="..\..\metadata_service_imp.pas"/>
<UnitName Value="metadata_service_imp"/>
<CursorPos X="58" Y="121"/>
<TopLine Value="1"/>
<UsageCount Value="14"/>
</Unit9>
<Unit10>
<Filename Value="..\..\metadata_service_binder.pas"/>
<UnitName Value="metadata_service_binder"/>
<CursorPos X="47" Y="16"/>
<TopLine Value="1"/>
<UsageCount Value="12"/>
</Unit10>
<Unit11>
<Filename Value="..\user_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="3" Y="27"/>
<TopLine Value="5"/>
<UsageCount Value="89"/>
</Unit11>
<Unit12>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="13" Y="1199"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="33"/>
<Bookmarks Count="1">
<Item0 X="19" Y="545" ID="0"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="..\..\wst_rtti_filter\std_cursors.pas"/>
<UnitName Value="std_cursors"/>
<CursorPos X="14" Y="21"/>
<TopLine Value="7"/>
<UsageCount Value="36"/>
</Unit13>
<Unit14>
<Filename Value="..\..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="3" Y="27"/>
<TopLine Value="15"/>
<UsageCount Value="23"/>
</Unit14>
<Unit15>
<Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="48" Y="34"/>
<TopLine Value="11"/>
<UsageCount Value="39"/>
</Unit15>
<Unit16>
<Filename Value="..\user_service_intf.wst"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
<SyntaxHighlighter Value="None"/>
</Unit16>
<Unit17>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="37" Y="571"/>
<TopLine Value="562"/>
<UsageCount Value="7"/>
</Unit17>
<Unit18>
<Filename Value="..\..\wst_resources_imp.pas"/>
<UnitName Value="wst_resources_imp"/>
<CursorPos X="15" Y="63"/>
<TopLine Value="45"/>
<UsageCount Value="7"/>
</Unit18>
<Unit19>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\except.inc"/>
<CursorPos X="3" Y="95"/>
<TopLine Value="73"/>
<UsageCount Value="5"/>
</Unit19>
<Unit20>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\i386\setjump.inc"/>
<CursorPos X="1" Y="36"/>
<TopLine Value="16"/>
<UsageCount Value="5"/>
</Unit20>
<Unit21>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\objpas.inc"/>
<CursorPos X="1" Y="76"/>
<TopLine Value="64"/>
<UsageCount Value="5"/>
</Unit21>
<Unit22>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\collect.inc"/>
<CursorPos X="1" Y="264"/>
<TopLine Value="252"/>
<UsageCount Value="5"/>
</Unit22>
<Unit23>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="1" Y="381"/>
<TopLine Value="369"/>
<UsageCount Value="5"/>
</Unit23>
<Unit24>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\system.inc"/>
<CursorPos X="1" Y="674"/>
<TopLine Value="662"/>
<UsageCount Value="5"/>
</Unit24>
<Unit25>
<Filename Value="..\..\server_service_intf.pas"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="5" Y="18"/>
<TopLine Value="72"/>
<EditorIndex Value="5"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\i386\i386.inc"/>
<CursorPos X="1" Y="1125"/>
<TopLine Value="1113"/>
<UsageCount Value="5"/>
</Unit26>
<Unit27>
<Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="60" Y="51"/>
<TopLine Value="28"/>
<EditorIndex Value="1"/>
<UsageCount Value="41"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="15" Y="23"/>
<TopLine Value="19"/>
<UsageCount Value="6"/>
</Unit28>
<Unit29>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="24" Y="967"/>
<TopLine Value="325"/>
<EditorIndex Value="6"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit29>
<Unit30>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="11" Y="247"/>
<TopLine Value="226"/>
<UsageCount Value="7"/>
</Unit30>
<Unit31>
<Filename Value="..\..\base_binary_formatter.pas"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="3" Y="1063"/>
<TopLine Value="1055"/>
<UsageCount Value="9"/>
</Unit31>
<Unit32>
<Filename Value="imp_helper.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="imp_helper"/>
<CursorPos X="1" Y="44"/>
<TopLine Value="32"/>
<UsageCount Value="58"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\persist.inc"/>
<CursorPos X="3" Y="36"/>
<TopLine Value="32"/>
<UsageCount Value="8"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\streams.inc"/>
<CursorPos X="43" Y="511"/>
<TopLine Value="506"/>
<UsageCount Value="8"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="1" Y="326"/>
<TopLine Value="314"/>
<UsageCount Value="8"/>
</Unit35>
<Unit36>
<Filename Value="..\..\synapse_tcp_server.pas"/>
<UnitName Value="synapse_tcp_server"/>
<CursorPos X="35" Y="92"/>
<TopLine Value="74"/>
<EditorIndex Value="3"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit36>
<Unit37>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="140"/>
<TopLine Value="30"/>
<UsageCount Value="10"/>
</Unit37>
<Unit38>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="4" Y="6"/>
<TopLine Value="1"/>
<UsageCount Value="18"/>
</Unit38>
<Unit39>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\i386\i386.inc"/>
<CursorPos X="1" Y="1246"/>
<TopLine Value="1234"/>
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysutils.inc"/>
<CursorPos X="1" Y="347"/>
<TopLine Value="334"/>
<UsageCount Value="9"/>
</Unit40>
<Unit41>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2393"/>
<UsageCount Value="13"/>
</Unit41>
<Unit42>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_xmlrpc"/>
<CursorPos X="26" Y="57"/>
<TopLine Value="21"/>
<EditorIndex Value="7"/>
<UsageCount Value="40"/>
<Loaded Value="True"/>
</Unit42>
<Unit43>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="16"/>
</Unit43>
<Unit44>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="111"/>
<TopLine Value="97"/>
<UsageCount Value="9"/>
</Unit44>
<Unit45>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysstr.inc"/>
<CursorPos X="3" Y="759"/>
<TopLine Value="756"/>
<UsageCount Value="9"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="483"/>
<TopLine Value="469"/>
<UsageCount Value="10"/>
</Unit46>
<Unit47>
<Filename Value="..\..\server_listener.pas"/>
<UnitName Value="server_listener"/>
<CursorPos X="21" Y="15"/>
<TopLine Value="6"/>
<EditorIndex Value="10"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit47>
<Unit48>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\inc\objpash.inc"/>
<CursorPos X="23" Y="147"/>
<TopLine Value="133"/>
<UsageCount Value="10"/>
</Unit48>
<Unit49>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="7" Y="1397"/>
<TopLine Value="1375"/>
<UsageCount Value="10"/>
</Unit49>
<Unit50>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\base\winunits\comobj.pp"/>
<UnitName Value="comobj"/>
<CursorPos X="14" Y="97"/>
<TopLine Value="114"/>
<UsageCount Value="10"/>
</Unit50>
<Unit51>
<Filename Value="..\..\..\..\lazarus\lazarus\others_package\synapse\synaip.pas"/>
<UnitName Value="synaip"/>
<CursorPos X="18" Y="59"/>
<TopLine Value="47"/>
<UsageCount Value="10"/>
</Unit51>
<Unit52>
<Filename Value="..\..\..\..\lazarus\lazarus\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit52>
<Unit53>
<Filename Value="..\..\..\..\lazarus\lazarus\others_package\synapse\ssfpc.pas"/>
<UnitName Value="ssfpc"/>
<CursorPos X="13" Y="554"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit53>
<Unit54>
<Filename Value="..\..\..\..\lazarus\lazarus\others_package\synapse\synautil.pas"/>
<UnitName Value="synautil"/>
<CursorPos X="44" Y="34"/>
<TopLine Value="26"/>
<UsageCount Value="10"/>
</Unit54>
<Unit55>
<Filename Value="..\..\..\..\lazarus\lazarus\others_package\synapse\synafpc.pas"/>
<UnitName Value="synafpc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="76"/>
<UsageCount Value="10"/>
</Unit55>
<Unit56>
<Filename Value="..\..\wst_fpc_xml.pas"/>
<UnitName Value="wst_fpc_xml"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit56>
<Unit57>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="10"/>
<EditorIndex Value="9"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit57>
<Unit58>
<Filename Value="..\..\wst_delphi.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit58>
<Unit59>
<Filename Value="..\..\config_objects.pas"/>
<UnitName Value="config_objects"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit59>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="tcp_server.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\;..\"/>
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/>
<SrcPath Value="$(LazarusDir)\others_package\synapse\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="6">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
<Item5>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="89"/>
</Item5>
<Item6>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="88"/>
</Item6>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

56
wst/tags/0.5/samples/tcp_server/tcp_server.pas Normal file
View File

@ -0,0 +1,56 @@
{
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 tcp_server;
{$INCLUDE wst.inc}
uses
{$IFDEF FPC}
{$IFDEF UNIX}
{$DEFINE UseCThreads}
{$ENDIF}
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
{$ENDIF}
Classes, SysUtils,
base_service_intf, server_service_soap,
base_binary_formatter, server_binary_formatter,
metadata_service, metadata_service_imp, metadata_service_binder,
server_listener , synapse_tcp_server,
user_service_intf, user_service_intf_binder, user_service_intf_imp , imp_helper,
server_service_xmlrpc;
var
listener : TwstListener;
begin
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterWSTMetadataServiceImplementationFactory();
//Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
WriteLn(Format('WST sample TCP Server listning on "%d"',[sSERVER_PORT]));
WriteLn('Hit <enter> to stop.');
listener := TwstSynapseTcpListener.Create();
listener.Start();
ReadLn;
end.

124
wst/tags/0.5/samples/user_client/umain.lfm Normal file
View File

@ -0,0 +1,124 @@
object fMain: TfMain
Left = 379
Height = 382
Top = 283
Width = 651
HorzScrollBar.Page = 650
VertScrollBar.Page = 381
ActiveControl = Grid
Caption = 'fMain'
ClientHeight = 382
ClientWidth = 651
Position = poMainFormCenter
object Panel1: TPanel
Height = 182
Top = 200
Width = 651
Align = alClient
BevelInner = bvLowered
Caption = 'Panel1'
ClientHeight = 182
ClientWidth = 651
TabOrder = 0
object Grid: TTIGrid
Left = 2
Height = 178
Top = 2
Width = 647
Align = alClient
AutoFillColumns = True
BorderSpacing.CellAlignHorizontal = ccaRightBottom
BorderStyle = bsNone
Filter = [tkInteger, tkChar, tkEnumeration, tkFloat, tkSString, tkLString, tkAString, tkWString, tkVariant, tkWChar, tkBool, tkInt64, tkQWord]
FixedColor = clBtnFace
Flat = True
OnGetObject = GridGetObject
OnGetObjectCount = GridGetObjectCount
OnGetObjectName = GridGetObjectName
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goColSizing, goRowMoving, goColMoving, goColSpanning, goDblClickAutoSize, goFixedRowNumbering, goScrollKeepVisible]
ParentColor = False
PropertyOrder.Strings = (
'Name'
'Category'
'Preferences'
'eMail'
)
TabOrder = 0
TabStop = True
end
end
object GroupBox1: TGroupBox
Height = 200
Width = 651
Align = alTop
ClientHeight = 178
ClientWidth = 647
TabOrder = 1
object btnSearch: TButton
Left = 500
Height = 35
Top = -1
Width = 131
Action = actSearch
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 0
end
object btnAdd: TButton
Left = 500
Height = 35
Top = 42
Width = 131
Action = actNew
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 1
end
object btnAdd1: TButton
Left = 500
Height = 35
Top = 87
Width = 131
Action = actUpdate
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 2
end
object btnAdd2: TButton
Left = 500
Height = 35
Top = 132
Width = 131
Action = actDelete
Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
TabOrder = 3
end
end
object AL: TActionList
left = 99
top = 56
object actNew: TAction
Caption = 'Create User'
DisableIfNoHandler = True
OnExecute = actNewExecute
end
object actUpdate: TAction
Caption = 'Update User'
DisableIfNoHandler = True
OnExecute = actUpdateExecute
OnUpdate = actUpdateUpdate
end
object actDelete: TAction
Caption = 'Delete'
DisableIfNoHandler = True
OnExecute = actDeleteExecute
OnUpdate = actUpdateUpdate
end
object actSearch: TAction
Caption = 'Get List'
DisableIfNoHandler = True
OnExecute = actSearchExecute
end
end
end

44
wst/tags/0.5/samples/user_client/umain.lrs Normal file
View File

@ -0,0 +1,44 @@
{ 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#27#1#5'Wid'
+'th'#3#139#2#18'HorzScrollBar.Page'#3#138#2#18'VertScrollBar.Page'#3'}'#1#13
+'ActiveControl'#7#4'Grid'#7'Caption'#6#5'fMain'#12'ClientHeight'#3'~'#1#11'C'
+'lientWidth'#3#139#2#8'Position'#7#16'poMainFormCenter'#0#6'TPanel'#6'Panel1'
+#6'Height'#3#182#0#3'Top'#3#200#0#5'Width'#3#139#2#5'Align'#7#8'alClient'#10
+'BevelInner'#7#9'bvLowered'#7'Caption'#6#6'Panel1'#12'ClientHeight'#3#182#0
+#11'ClientWidth'#3#139#2#8'TabOrder'#2#0#0#7'TTIGrid'#4'Grid'#4'Left'#2#2#6
+'Height'#3#178#0#3'Top'#2#2#5'Width'#3#135#2#5'Align'#7#8'alClient'#15'AutoF'
+'illColumns'#9'!BorderSpacing.CellAlignHorizontal'#7#14'ccaRightBottom'#11'B'
+'orderStyle'#7#6'bsNone'#6'Filter'#11#9'tkInteger'#6'tkChar'#13'tkEnumeratio'
+'n'#7'tkFloat'#9'tkSString'#9'tkLString'#9'tkAString'#9'tkWString'#9'tkVaria'
+'nt'#7'tkWChar'#6'tkBool'#7'tkInt64'#7'tkQWord'#0#10'FixedColor'#7#9'clBtnFa'
+'ce'#4'Flat'#9#11'OnGetObject'#7#13'GridGetObject'#16'OnGetObjectCount'#7#18
+'GridGetObjectCount'#15'OnGetObjectName'#7#17'GridGetObjectName'#7'Options'
+#11#15'goFixedVertLine'#15'goFixedHorzLine'#10'goVertLine'#10'goHorzLine'#13
+'goRangeSelect'#19'goDrawFocusSelected'#11'goColSizing'#11'goRowMoving'#11'g'
+'oColMoving'#13'goColSpanning'#18'goDblClickAutoSize'#19'goFixedRowNumbering'
+#19'goScrollKeepVisible'#0#11'ParentColor'#8#21'PropertyOrder.Strings'#1#6#4
+'Name'#6#8'Category'#6#11'Preferences'#6#5'eMail'#0#8'TabOrder'#2#0#7'TabSto'
+'p'#9#0#0#0#9'TGroupBox'#9'GroupBox1'#6'Height'#3#200#0#5'Width'#3#139#2#5'A'
+'lign'#7#5'alTop'#12'ClientHeight'#3#178#0#11'ClientWidth'#3#135#2#8'TabOrde'
+'r'#2#1#0#7'TButton'#9'btnSearch'#4'Left'#3#244#1#6'Height'#2'#'#3'Top'#2#255
+#5'Width'#3#131#0#6'Action'#7#9'actSearch'#7'Anchors'#11#5'akTop'#7'akRight'
+#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#0#0#0#7'TButton'#6'btnAdd'
+#4'Left'#3#244#1#6'Height'#2'#'#3'Top'#2'*'#5'Width'#3#131#0#6'Action'#7#6'a'
+'ctNew'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4
+#8'TabOrder'#2#1#0#0#7'TButton'#7'btnAdd1'#4'Left'#3#244#1#6'Height'#2'#'#3
+'Top'#2'W'#5'Width'#3#131#0#6'Action'#7#9'actUpdate'#7'Anchors'#11#5'akTop'#7
+'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#7'TButton'
+#7'btnAdd2'#4'Left'#3#244#1#6'Height'#2'#'#3'Top'#3#132#0#5'Width'#3#131#0#6
+'Action'#7#9'actDelete'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing'
+'.InnerBorder'#2#4#8'TabOrder'#2#3#0#0#0#11'TActionList'#2'AL'#4'left'#2'c'#3
+'top'#2'8'#0#7'TAction'#6'actNew'#7'Caption'#6#11'Create User'#18'DisableIfN'
+'oHandler'#9#9'OnExecute'#7#13'actNewExecute'#0#0#7'TAction'#9'actUpdate'#7
+'Caption'#6#11'Update User'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actUp'
+'dateExecute'#8'OnUpdate'#7#15'actUpdateUpdate'#0#0#7'TAction'#9'actDelete'#7
+'Caption'#6#6'Delete'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actDeleteEx'
+'ecute'#8'OnUpdate'#7#15'actUpdateUpdate'#0#0#7'TAction'#9'actSearch'#7'Capt'
+'ion'#6#8'Get List'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actSearchExec'
+'ute'#0#0#0#0
]);

169
wst/tags/0.5/samples/user_client/umain.pas Normal file
View File

@ -0,0 +1,169 @@
unit umain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, RTTIGrids,
ExtCtrls, StdCtrls, user_service_intf, Buttons, ActnList;
type
{ TfMain }
TfMain = class(TForm)
actDelete: TAction;
actSearch: TAction;
actUpdate: TAction;
actNew: TAction;
AL: TActionList;
btnAdd1: TButton;
btnAdd2: TButton;
btnSearch: TButton;
btnAdd: TButton;
GroupBox1: TGroupBox;
Panel1: TPanel;
Grid: TTIGrid;
procedure actDeleteExecute(Sender: TObject);
procedure actNewExecute(Sender: TObject);
procedure actSearchExecute(Sender: TObject);
procedure actUpdateExecute(Sender: TObject);
procedure actUpdateUpdate(Sender: TObject);
procedure GridGetObject(Sender: TTICustomGrid; Index: integer;
var TIObject: TPersistent);
procedure GridGetObjectCount(Sender: TTICustomGrid; ListObject: TObject;
var ObjCount: integer);
procedure GridGetObjectName(Sender: TObject; Index: integer;
TIObject: TPersistent; var ObjName: string);
private
FUserService : UserService;
function CreateObj():UserService;
function GetObjectIndex() : Integer;
public
FUsers : TUserArray;
end;
var
fMain: TfMain;
implementation
uses user_service_intf_proxy, synapse_tcp_protocol, synapse_http_protocol,
soap_formatter, binary_formatter, user_edit_imp ;
{ TfMain }
procedure TfMain.GridGetObjectCount(Sender: TTICustomGrid;
ListObject: TObject; var ObjCount: integer);
begin
if ( FUsers = nil ) then
ObjCount := 0
else
ObjCount := FUsers.Length;
end;
procedure TfMain.GridGetObjectName(Sender: TObject; Index: integer;
TIObject: TPersistent; var ObjName: string);
begin
if ( TIObject <> nil ) then
ObjName := (TIObject as TUser).UserName;
end;
function TfMain.CreateObj(): UserService;
begin
if ( FUserService = nil ) then begin
FUserService := TUserService_Proxy.Create(
'UserService',
'binary:',
'TCP:Address=127.0.0.1;Port=1234;target=UserService'
);
end;
Result := FUserService;
end;
type TCrakGrid = class(TTIGrid);
function TfMain.GetObjectIndex(): Integer;
begin
Result := TCrakGrid(Grid).Row - 1;
end;
procedure TfMain.GridGetObject(Sender: TTICustomGrid; Index: integer;
var TIObject: TPersistent);
begin
TIObject := FUsers[Index];
end;
procedure TfMain.actNewExecute(Sender: TObject);
var
obj : TUser;
f : TfUserEdit;
begin
obj := nil;
f := TfUserEdit.Create(Application);
try
obj := TUser.Create();
if f.UpdateObject(obj) then begin
CreateObj().Add(obj);
end;
finally
FreeAndNil(obj);
f.Release();
actSearch.Execute();
end;
end;
procedure TfMain.actSearchExecute(Sender: TObject);
begin
FreeAndNil(FUsers);
FUsers := CreateObj().GetList();
Grid.ListObject := FUsers;
Grid.Invalidate();
end;
procedure TfMain.actDeleteExecute(Sender: TObject);
var
i : Integer;
begin
i := GetObjectIndex();
if ( i >= 0 ) then begin
try
CreateObj().Delete(FUsers[i].UserName);
finally
actSearch.Execute();
end;
end;
end;
procedure TfMain.actUpdateExecute(Sender: TObject);
var
i : Integer;
obj : TUser;
f : TfUserEdit;
begin
i := GetObjectIndex();
if ( i >= 0 ) then begin
obj := FUsers[i];
f := TfUserEdit.Create(Application);
try
if f.UpdateObject(obj) then begin
CreateObj().Update(obj);
end;
finally
f.Release();
actSearch.Execute();
end;
end;
end;
procedure TfMain.actUpdateUpdate(Sender: TObject);
begin
TAction(Sender).Enabled := ( GetObjectIndex() >= 0 );
end;
initialization
{$I umain.lrs}
SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport();
end.

362
wst/tags/0.5/samples/user_client/user_client.lpi Normal file
View File

@ -0,0 +1,362 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="7"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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="RunTimeTypeInfoControls"/>
<MinVersion Minor="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="21">
<Unit0>
<Filename Value="user_client.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_client"/>
<CursorPos X="9" Y="9"/>
<TopLine Value="1"/>
<UsageCount Value="44"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
<ComponentName Value="fMain"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="44" Y="130"/>
<TopLine Value="116"/>
<EditorIndex Value="0"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="64" Y="30"/>
<TopLine Value="25"/>
<EditorIndex Value="6"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\user_service_intf_proxy.pas"/>
<UnitName Value="user_service_intf_proxy"/>
<CursorPos X="24" Y="21"/>
<TopLine Value="13"/>
<EditorIndex Value="5"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="58" Y="28"/>
<TopLine Value="23"/>
<EditorIndex Value="4"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="3316"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\..\..\lazarus23_213\components\rtticontrols\rttigrids.pas"/>
<UnitName Value="RTTIGrids"/>
<CursorPos X="13" Y="680"/>
<TopLine Value="663"/>
<UsageCount Value="12"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\..\..\lazarus23_213\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<CursorPos X="14" Y="829"/>
<TopLine Value="494"/>
<UsageCount Value="12"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="7" Y="29"/>
<TopLine Value="19"/>
<UsageCount Value="9"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\types.pp"/>
<UnitName Value="types"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="268"/>
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1276"/>
<UsageCount Value="9"/>
</Unit10>
<Unit11>
<Filename Value="user_edit_imp.pas"/>
<ComponentName Value="fUserEdit"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="user_edit_imp.lrs"/>
<UnitName Value="user_edit_imp"/>
<CursorPos X="19" Y="27"/>
<TopLine Value="27"/>
<EditorIndex Value="7"/>
<UsageCount Value="37"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\..\lazarus23_213\components\rtticontrols\rttictrls.pas"/>
<UnitName Value="RTTICtrls"/>
<CursorPos X="3" Y="2239"/>
<TopLine Value="2237"/>
<UsageCount Value="12"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\..\lazarus23_213\lcl\interfaces\win32\interfaces.pp"/>
<UnitName Value="Interfaces"/>
<CursorPos X="25" Y="40"/>
<TopLine Value="22"/>
<UsageCount Value="9"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\..\..\lazarus23_213\lcl\interfaces\win32\win32int.pp"/>
<UnitName Value="Win32Int"/>
<CursorPos X="34" Y="50"/>
<TopLine Value="246"/>
<UsageCount Value="9"/>
</Unit14>
<Unit15>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\resh.inc"/>
<CursorPos X="3" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit15>
<Unit16>
<Filename Value="user_edit_imp.lrs"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit16>
<Unit17>
<Filename Value="..\..\binary_formatter.pas"/>
<UnitName Value="binary_formatter"/>
<CursorPos X="58" Y="132"/>
<TopLine Value="113"/>
<EditorIndex Value="3"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="..\..\..\..\..\lazarus23_213\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<CursorPos X="15" Y="1653"/>
<TopLine Value="1635"/>
<UsageCount Value="9"/>
</Unit18>
<Unit19>
<Filename Value="..\..\..\..\..\lazarus23_213\ideintf\propedits.pp"/>
<UnitName Value="PropEdits"/>
<CursorPos X="49" Y="4174"/>
<TopLine Value="4157"/>
<UsageCount Value="10"/>
</Unit19>
<Unit20>
<Filename Value="..\..\base_binary_formatter.pas"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="1" Y="1511"/>
<TopLine Value="1497"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit20>
</Units>
<JumpHistory Count="23" HistoryIndex="22">
<Position1>
<Filename Value="umain.pas"/>
<Caret Line="126" Column="27" TopLine="114"/>
</Position1>
<Position2>
<Filename Value="umain.pas"/>
<Caret Line="120" Column="17" TopLine="106"/>
</Position2>
<Position3>
<Filename Value="umain.pas"/>
<Caret Line="79" Column="36" TopLine="77"/>
</Position3>
<Position4>
<Filename Value="umain.pas"/>
<Caret Line="27" Column="5" TopLine="26"/>
</Position4>
<Position5>
<Filename Value="umain.pas"/>
<Caret Line="151" Column="22" TopLine="75"/>
</Position5>
<Position6>
<Filename Value="umain.pas"/>
<Caret Line="29" Column="49" TopLine="28"/>
</Position6>
<Position7>
<Filename Value="umain.pas"/>
<Caret Line="31" Column="48" TopLine="14"/>
</Position7>
<Position8>
<Filename Value="umain.pas"/>
<Caret Line="159" Column="3" TopLine="141"/>
</Position8>
<Position9>
<Filename Value="umain.pas"/>
<Caret Line="120" Column="1" TopLine="117"/>
</Position9>
<Position10>
<Filename Value="umain.pas"/>
<Caret Line="85" Column="38" TopLine="142"/>
</Position10>
<Position11>
<Filename Value="umain.pas"/>
<Caret Line="158" Column="51" TopLine="142"/>
</Position11>
<Position12>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="15" TopLine="1"/>
</Position12>
<Position13>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="18" TopLine="10"/>
</Position13>
<Position14>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="18" TopLine="10"/>
</Position14>
<Position15>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="19" TopLine="10"/>
</Position15>
<Position16>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="19" TopLine="10"/>
</Position16>
<Position17>
<Filename Value="..\user_service_intf_proxy.pas"/>
<Caret Line="21" Column="24" TopLine="13"/>
</Position17>
<Position18>
<Filename Value="umain.pas"/>
<Caret Line="158" Column="51" TopLine="1"/>
</Position18>
<Position19>
<Filename Value="umain.pas"/>
<Caret Line="69" Column="44" TopLine="55"/>
</Position19>
<Position20>
<Filename Value="umain.pas"/>
<Caret Line="130" Column="44" TopLine="116"/>
</Position20>
<Position21>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="25" Column="19" TopLine="13"/>
</Position21>
<Position22>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="26" Column="23" TopLine="13"/>
</Position22>
<Position23>
<Filename Value="user_edit_imp.pas"/>
<Caret Line="27" Column="22" TopLine="13"/>
</Position23>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="user_client.exe"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="C:\Programmes\lazarus\wst\samples\;$(LazarusDir)\others_package\synapse\;C:\Programmes\lazarus\wst\"/>
<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>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

19
wst/tags/0.5/samples/user_client/user_client.lpr Normal file
View File

@ -0,0 +1,19 @@
program user_client;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
, umain, RunTimeTypeInfoControls, user_edit_imp;
begin
Application.Initialize;
Application.CreateForm(TfMain, fMain);
Application.CreateForm(TfUserEdit, fUserEdit);
Application.Run;
end.

124
wst/tags/0.5/samples/user_client/user_edit_imp.lfm Normal file
View File

@ -0,0 +1,124 @@
object fUserEdit: TfUserEdit
Left = 395
Height = 241
Top = 199
Width = 400
HorzScrollBar.Page = 399
VertScrollBar.Page = 240
ActiveControl = btnOk
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'User Edit'
ClientHeight = 241
ClientWidth = 400
Position = poMainFormCenter
object Panel1: TPanel
Height = 50
Top = 191
Width = 400
Align = alBottom
ClientHeight = 50
ClientWidth = 400
TabOrder = 0
object btnOk: TButton
Left = 224
Height = 35
Top = 6
Width = 75
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
end
object Button2: TButton
Left = 312
Height = 35
Top = 6
Width = 75
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object Panel2: TPanel
Height = 191
Width = 400
Align = alClient
ClientHeight = 191
ClientWidth = 400
TabOrder = 1
object Label1: TLabel
Left = 16
Height = 18
Top = 18
Width = 36
Caption = 'Name'
Color = clNone
ParentColor = False
end
object Label2: TLabel
Left = 16
Height = 18
Top = 53
Width = 34
Caption = 'e-Mail'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 16
Height = 18
Top = 88
Width = 58
Caption = 'Category'
Color = clNone
ParentColor = False
end
object Label4: TLabel
Left = 17
Height = 18
Top = 120
Width = 72
Caption = 'Preferences'
Color = clNone
ParentColor = False
end
object edtName: TTIEdit
Left = 80
Height = 23
Top = 16
Width = 304
Link.TIPropertyName = 'UserName'
TabOrder = 0
end
object edteMail: TTIEdit
Left = 80
Height = 23
Top = 53
Width = 304
Link.TIPropertyName = 'eMail'
TabOrder = 1
end
object edtCategory: TTIComboBox
Left = 80
Height = 24
Top = 88
Width = 160
Link.TIPropertyName = 'Category'
MaxLength = 0
Style = csDropDownList
TabOrder = 2
end
object edtPreferences: TTIEdit
Left = 17
Height = 23
Top = 146
Width = 368
Link.TIPropertyName = 'Preferences'
TabOrder = 3
end
end
end

34
wst/tags/0.5/samples/user_client/user_edit_imp.lrs Normal file
View File

@ -0,0 +1,34 @@
{ Ceci est un fichier ressource g�n�r� automatiquement par Lazarus }
LazarusResources.Add('TfUserEdit','FORMDATA',[
'TPF0'#10'TfUserEdit'#9'fUserEdit'#4'Left'#3#139#1#6'Height'#3#241#0#3'Top'#3
+#199#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'
+#3#240#0#13'ActiveControl'#7#5'btnOk'#11'BorderIcons'#11#12'biSystemMenu'#0
+#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#9'User Edit'#12'ClientHeight'#3
+#241#0#11'ClientWidth'#3#144#1#8'Position'#7#16'poMainFormCenter'#0#6'TPanel'
+#6'Panel1'#6'Height'#2'2'#3'Top'#3#191#0#5'Width'#3#144#1#5'Align'#7#8'alBot'
+'tom'#12'ClientHeight'#2'2'#11'ClientWidth'#3#144#1#8'TabOrder'#2#0#0#7'TBut'
+'ton'#5'btnOk'#4'Left'#3#224#0#6'Height'#2'#'#3'Top'#2#6#5'Width'#2'K'#25'Bo'
+'rderSpacing.InnerBorder'#2#4#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'
+#2#1#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'8'#1#6'Height'#2'#'
+#3'Top'#2#6#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Ca'
+'ption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#6'TPanel'#6'Pa'
+'nel2'#6'Height'#3#191#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#12'ClientHe'
+'ight'#3#191#0#11'ClientWidth'#3#144#1#8'TabOrder'#2#1#0#6'TLabel'#6'Label1'
+#4'Left'#2#16#6'Height'#2#18#3'Top'#2#18#5'Width'#2'$'#7'Caption'#6#4'Name'#5
+'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#6
+'Height'#2#18#3'Top'#2'5'#5'Width'#2'"'#7'Caption'#6#6'e-Mail'#5'Color'#7#6
+'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2
+#18#3'Top'#2'X'#5'Width'#2':'#7'Caption'#6#8'Category'#5'Color'#7#6'clNone'
+#11'ParentColor'#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#17#6'Height'#2#18#3'Top'
+#2'x'#5'Width'#2'H'#7'Caption'#6#11'Preferences'#5'Color'#7#6'clNone'#11'Par'
+'entColor'#8#0#0#7'TTIEdit'#7'edtName'#4'Left'#2'P'#6'Height'#2#23#3'Top'#2
+#16#5'Width'#3'0'#1#19'Link.TIPropertyName'#6#8'UserName'#8'TabOrder'#2#0#0#0
+#7'TTIEdit'#8'edteMail'#4'Left'#2'P'#6'Height'#2#23#3'Top'#2'5'#5'Width'#3'0'
+#1#19'Link.TIPropertyName'#6#5'eMail'#8'TabOrder'#2#1#0#0#11'TTIComboBox'#11
+'edtCategory'#4'Left'#2'P'#6'Height'#2#24#3'Top'#2'X'#5'Width'#3#160#0#19'Li'
+'nk.TIPropertyName'#6#8'Category'#9'MaxLength'#2#0#5'Style'#7#14'csDropDownL'
+'ist'#8'TabOrder'#2#2#0#0#7'TTIEdit'#14'edtPreferences'#4'Left'#2#17#6'Heigh'
+'t'#2#23#3'Top'#3#146#0#5'Width'#3'p'#1#19'Link.TIPropertyName'#6#11'Prefere'
+'nces'#8'TabOrder'#2#3#0#0#0#0
]);

73
wst/tags/0.5/samples/user_client/user_edit_imp.pas Normal file
View File

@ -0,0 +1,73 @@
unit user_edit_imp;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls, RTTICtrls, user_service_intf;
type
{ TfUserEdit }
TfUserEdit = class(TForm)
btnOk: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Panel1: TPanel;
Panel2: TPanel;
edtCategory: TTIComboBox;
edtName: TTIEdit;
edteMail: TTIEdit;
edtPreferences: TTIEdit;
private
FInfos: TUser;
public
constructor Create(AOwner : TComponent);override;
destructor Destroy();override;
property Infos : TUser read FInfos;
function UpdateObject( AUser : TUser ) : Boolean;
end;
var
fUserEdit: TfUserEdit;
implementation
{ TfUserEdit }
constructor TfUserEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInfos := TUser.Create();
edtName.Link.TIObject := FInfos;
edteMail.Link.TIObject := FInfos;
edtPreferences.Link.TIObject := FInfos;
edtCategory.Link.TIObject := FInfos;
end;
destructor TfUserEdit.Destroy();
begin
FreeAndNil(FInfos);
inherited Destroy();
end;
function TfUserEdit.UpdateObject(AUser: TUser): Boolean;
begin
Infos.Assign(AUser);
Result := ( ShowModal() = mrOK );
if Result then begin
AUser.Assign(Infos);
end;
end;
initialization
{$I user_edit_imp.lrs}
end.

423
wst/tags/0.5/samples/user_client_console/user_client_console.lpi Normal file
View File

@ -0,0 +1,423 @@
<?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>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<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>
<Units Count="43">
<Unit0>
<Filename Value="user_client_console.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_client_console"/>
<CursorPos X="14" Y="269"/>
<TopLine Value="252"/>
<EditorIndex Value="0"/>
<UsageCount Value="76"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="..\user_service_intf_proxy.pas"/>
<UnitName Value="user_service_intf_proxy"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="17" Y="29"/>
<TopLine Value="16"/>
<EditorIndex Value="14"/>
<UsageCount Value="37"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="51" Y="34"/>
<TopLine Value="21"/>
<EditorIndex Value="11"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="53" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="60" Y="2413"/>
<TopLine Value="2393"/>
<UsageCount Value="5"/>
</Unit5>
<Unit6>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="32"/>
</Unit6>
<Unit7>
<Filename Value="..\..\library_protocol.pas"/>
<UnitName Value="library_protocol"/>
<CursorPos X="57" Y="57"/>
<TopLine Value="2"/>
<EditorIndex Value="10"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\finah.inc"/>
<CursorPos X="10" Y="33"/>
<TopLine Value="17"/>
<UsageCount Value="5"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\fina.inc"/>
<CursorPos X="13" Y="112"/>
<TopLine Value="105"/>
<UsageCount Value="5"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="33" Y="202"/>
<TopLine Value="188"/>
<UsageCount Value="5"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win32\system.pp"/>
<UnitName Value="System"/>
<CursorPos X="20" Y="35"/>
<TopLine Value="21"/>
<UsageCount Value="5"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\fexpand.inc"/>
<CursorPos X="10" Y="86"/>
<TopLine Value="226"/>
<UsageCount Value="5"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="54" Y="33"/>
<TopLine Value="19"/>
<UsageCount Value="5"/>
</Unit13>
<Unit14>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<UnitName Value="synapse_http_protocol"/>
<CursorPos X="15" Y="59"/>
<TopLine Value="45"/>
<EditorIndex Value="9"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit14>
<Unit15>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit15>
<Unit16>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="17" Y="15"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit16>
<Unit17>
<Filename Value="..\..\library_imp_utils.pas"/>
<UnitName Value="library_imp_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit17>
<Unit18>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\dynlibs.inc"/>
<CursorPos X="17" Y="27"/>
<TopLine Value="13"/>
<UsageCount Value="6"/>
</Unit18>
<Unit19>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="140"/>
<TopLine Value="111"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit19>
<Unit20>
<Filename Value="..\..\soap_formatter.pas"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="3" Y="232"/>
<TopLine Value="221"/>
<EditorIndex Value="8"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="..\..\xmlrpc_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xmlrpc_formatter"/>
<CursorPos X="54" Y="21"/>
<TopLine Value="1"/>
<UsageCount Value="62"/>
</Unit21>
<Unit22>
<Filename Value="..\..\binary_formatter.pas"/>
<UnitName Value="binary_formatter"/>
<CursorPos X="20" Y="21"/>
<TopLine Value="12"/>
<EditorIndex Value="12"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
<Filename Value="..\..\wst_delphi.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="6"/>
</Unit23>
<Unit24>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="25" Y="31"/>
<TopLine Value="16"/>
<UsageCount Value="25"/>
</Unit24>
<Unit25>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="3" Y="40"/>
<TopLine Value="22"/>
<UsageCount Value="24"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="592"/>
<TopLine Value="590"/>
<UsageCount Value="11"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="483"/>
<TopLine Value="469"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2393"/>
<UsageCount Value="11"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\packages\fcl-xml\src\xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="1" Y="2763"/>
<TopLine Value="2749"/>
<UsageCount Value="11"/>
</Unit29>
<Unit30>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="41" Y="3"/>
<TopLine Value="1"/>
<UsageCount Value="15"/>
</Unit30>
<Unit31>
<Filename Value="..\..\wst_fpc_xml.pas"/>
<UnitName Value="wst_fpc_xml"/>
<CursorPos X="34" Y="67"/>
<TopLine Value="42"/>
<EditorIndex Value="13"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit31>
<Unit32>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="34"/>
<UsageCount Value="8"/>
</Unit32>
<Unit33>
<Filename Value="..\..\base_binary_formatter.pas"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="22" Y="27"/>
<TopLine Value="10"/>
<UsageCount Value="14"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-xml\src\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="14" Y="287"/>
<TopLine Value="274"/>
<UsageCount Value="11"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\others_package\synapse\httpsend.pas"/>
<UnitName Value="httpsend"/>
<CursorPos X="23" Y="72"/>
<TopLine Value="143"/>
<UsageCount Value="10"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="3" Y="1325"/>
<TopLine Value="1279"/>
<UsageCount Value="10"/>
</Unit36>
<Unit37>
<Filename Value="..\..\indy_http_protocol.pas"/>
<UnitName Value="indy_http_protocol"/>
<CursorPos X="1" Y="16"/>
<TopLine Value="109"/>
<EditorIndex Value="7"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdHTTP.pas"/>
<UnitName Value="IdHTTP"/>
<CursorPos X="49" Y="343"/>
<TopLine Value="582"/>
<UsageCount Value="9"/>
</Unit38>
<Unit39>
<Filename Value="..\..\ics_tcp_protocol.pas"/>
<UnitName Value="ics_tcp_protocol"/>
<CursorPos X="1" Y="31"/>
<TopLine Value="18"/>
<UsageCount Value="14"/>
</Unit39>
<Unit40>
<Filename Value="..\..\ics_http_protocol.pas"/>
<UnitName Value="ics_http_protocol"/>
<CursorPos X="55" Y="72"/>
<TopLine Value="128"/>
<EditorIndex Value="6"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit40>
<Unit41>
<Filename Value="..\..\same_process_protocol.pas"/>
<UnitName Value="same_process_protocol"/>
<CursorPos X="77" Y="83"/>
<TopLine Value="31"/>
<EditorIndex Value="5"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit41>
<Unit42>
<Filename Value="..\..\type_lib_edtr\ubindingedit.pas"/>
<ComponentName Value="fBindingEdit"/>
<HasResources Value="True"/>
<ResourceFilename Value="..\..\type_lib_edtr\ubindingedit.lrs"/>
<UnitName Value="ubindingedit"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit42>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="user_client_console.exe"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\;..\..\;$(LazarusDir)\others_package\synapse\;$(LazarusDir)\others_package\ics\latest_distr\Delphi\Vc32\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

279
wst/tags/0.5/samples/user_client_console/user_client_console.pas Normal file
View File

@ -0,0 +1,279 @@
program user_client_console;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, TypInfo, {$IFDEF WINDOWS}ActiveX,{$ENDIF}
user_service_intf_proxy,
same_process_protocol, synapse_tcp_protocol, synapse_http_protocol, library_protocol, //ics_tcp_protocol, ics_http_protocol,
soap_formatter, binary_formatter,
user_service_intf, xmlrpc_formatter;
type
TUser = TUser_Type;
TUserCategory = TUserCategory_Type;
var
UserServiceInst : UserService;
procedure ShowUser(AUser : TUser);
begin
if ( AUser <> nil ) then begin
WriteLn(' Name = ',AUser.UserName);
WriteLn(' Category = ',GetEnumName(TypeInfo(TUserCategory),Ord(AUser.Category)));
WriteLn(' e-Mail = ',AUser.eMail);
WriteLn(' Preferences = ',AUser.Preferences);
WriteLn(' Note');
WriteLn(' Header = ',AUser.Note.Header);
WriteLn(' Author = ',AUser.Note.Author);
WriteLn(' Date = ',AUser.Note.Date);
end else begin
WriteLn('<Empty User>');
end;
end;
procedure ShowUserArray(AArray : TUserArray);
var
i, c : Integer;
usr : TUser;
begin
if ( AArray <> nil ) then begin
c := AArray.Length;
for i := 0 to Pred(c) do begin
usr := AArray[i];
WriteLn();
WriteLn(Format('User[%d] : ',[(i+1)]));
ShowUser(usr);
end;
end;
end;
procedure HandleShowAll();
var
userArray : TUserArray;
begin
userArray := UserServiceInst.GetList();
try
if ( userArray <> nil ) and ( userArray.Length > 0 ) then begin
ShowUserArray(userArray);
end else begin
WriteLn('Empty Array.');
end;
finally
FreeAndNil(userArray);
end;
end;
type TAddType = ( atAdd, atUpdate );
procedure HandleAdd(const AType :TAddType);
const CAPTIONS : array[TAddType] of string = ( 'Adding a user :', 'Updating a user :' );
function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
begin
Result := '';
Write(APrompt);
ReadLn(Result);
Result := Trim(Result);
if ANonNull and ( Length(Result) = 0 ) then
Raise Exception.Create('Invalid User Name!');
end;
var
usr : TUser;
buff : string;
begin
buff := '';
WriteLn(CAPTIONS[AType]);
try
usr := TUser.Create();
try
usr.UserName := ReadItem('Enter user name : ',True);
buff := UpperCase(ReadItem('Enter user Category( A : Admin; N : normal ) : ',True));
if ( buff[1] = 'A' ) then
usr.Category:= Admin
else
usr.Category:= Normal;
usr.eMail := ReadItem('Enter user e-mail : ',False);
usr.Preferences := ReadItem('Enter user Preferences : ',False);
buff := UpperCase(ReadItem('Do you want to add some notes : ',True));
if ( buff[1] = 'O' ) then begin
usr.Note.Header := ReadItem('Enter user Note.Header : ',False);
usr.Note.Author := ReadItem('Enter user Note.Author : ',False);
usr.Note.Date := ReadItem('Enter user Note.Date : ',False);
end;
if ( AType = atUpdate ) then
UserServiceInst.Update(usr)
else
UserServiceInst.Add(usr);
finally
FreeAndNil(usr);
end;
except
on e : Exception do begin
WriteLn(e.Message);
end;
end;
end;
procedure HandleFindUser();
var
user : TUser;
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
user := UserServiceInst.Find(buff);
try
ShowUser(user);
finally
FreeAndNil(user);
end;
end;
procedure HandleDeleteUser();
var
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
UserServiceInst.Delete(buff);
end;
type
TTransportType = ( ttLibrary, ttTCP, ttHTTP );
TFormatType = ( ftBinary, ftSoap, ftXmlRPC );
var
TransportType : TTransportType;
FormatValue : TFormatType;
procedure CreateProxy();
const ADDRESS_MAP : array[TTransportType] of string = (
'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
//'TCP:Address=172.16.82.31;Port=1234;target=UserService',
'TCP:Address=127.0.0.1;Port=1234;target=UserService',
//'http:Address=http://127.0.0.1:8080/wst/services/UserService/?format=soap'
'http:Address=http://127.0.0.1:8000/services/UserService'
);
FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc' );
var
buff : string;
begin
if ( TransportType = ttHTTP ) then
buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
else
buff := ADDRESS_MAP[TransportType];
if ( TransportType = ttLibrary ) then
buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
UserServiceInst := TUserService_Proxy.Create(
'UserService',
FORMAT_MAP[FormatValue] + ':',
buff
);
end;
procedure ReadTransportType();
var
buff : string;
begin
WriteLn();
WriteLn('Select a transport protocol : ');
WriteLn(' L : Library, the lib_server project must have been built');
WriteLn(' T : TCP, the tcp_server must have been built');
WriteLn(' H : HTTP, the http_server must have been built');
WriteLn();
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
case buff[1] of
'L' : TransportType := ttLibrary;
'T' : TransportType := ttTCP;
'H' : TransportType := ttHTTP;
end;
Break;
end;
end;
end;
procedure ReadFormatType();
var
buff : string;
begin
WriteLn();
WriteLn('Select a messaging format : ');
WriteLn(' B : binary ( binary_formatter.pas )');
WriteLn(' S : soap ( soap_formatter.pas )');
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
WriteLn();
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['B','S', 'X'] ) then begin
case buff[1] of
'B' : FormatValue := ftBinary;
'S' : FormatValue := ftSoap;
'X' : FormatValue := ftXmlRPC;
end;
Break;
end;
end;
end;
var
strBuffer : string;
begin
{$IFDEF WINDOWS}
CoInitialize(nil);
try
{$ENDIF}
SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport();
WriteLn('Sample Application using Web Services Toolkit');
ReadFormatType();
ReadTransportType();
CreateProxy();
WriteLn('Menu :');
WriteLn(' L : Show the user list');
WriteLn(' A : Add a new user');
WriteLn(' U : Update a user');
WriteLn(' D : Delete a user');
WriteLn(' F : Find a new');
WriteLn(' C : Change the communication protocol');
WriteLn(' Z : Change the messaging format');
WriteLn(' X : Exit');
WriteLn();
Write('Choose a item : ');
while True do begin
strBuffer := '';
ReadLn(strBuffer);
strBuffer := UpperCase(Trim(strBuffer));
if ( Length(strBuffer) > 0 ) then begin
case strBuffer[1] of
'L' : HandleShowAll();
'A' : HandleAdd(atAdd);
'U' : HandleAdd(atUpdate);
'D' : HandleDeleteUser();
'F' : HandleFindUser();
'C' :
begin
ReadTransportType();
CreateProxy();
end;
'Z' :
begin
ReadFormatType();
CreateProxy();
end;
'X' : Break;
end;
WriteLn();
Write('Choose a item : ');
end;
end;
{$IFDEF WINDOWS}
finally
CoUninitialize();
end;
{$ENDIF}
end.

200
wst/tags/0.5/samples/user_client_readbuffer/readbuffer_sample.lpi Normal file
View File

@ -0,0 +1,200 @@
<?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>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<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>
<Units Count="5">
<Unit0>
<Filename Value="readbuffer_sample.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="readbuffer_sample"/>
<CursorPos X="1" Y="27"/>
<TopLine Value="6"/>
<EditorIndex Value="0"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="user_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="1" Y="27"/>
<TopLine Value="23"/>
<EditorIndex Value="2"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="user_service_intf_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf_proxy"/>
<CursorPos X="71" Y="12"/>
<TopLine Value="10"/>
<EditorIndex Value="4"/>
<UsageCount Value="25"/>
<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="3"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="12" Y="29"/>
<TopLine Value="16"/>
<EditorIndex Value="1"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit4>
</Units>
<JumpHistory Count="16" HistoryIndex="15">
<Position1>
<Filename Value="user_service_intf_proxy.pas"/>
<Caret Line="12" Column="71" TopLine="10"/>
</Position1>
<Position2>
<Filename Value="user_service_intf.pas"/>
<Caret Line="27" Column="25" TopLine="17"/>
</Position2>
<Position3>
<Filename Value="user_service_intf.pas"/>
<Caret Line="29" Column="21" TopLine="14"/>
</Position3>
<Position4>
<Filename Value="user_service_intf.pas"/>
<Caret Line="299" Column="8" TopLine="270"/>
</Position4>
<Position5>
<Filename Value="user_service_intf.pas"/>
<Caret Line="50" Column="38" TopLine="35"/>
</Position5>
<Position6>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="317" Column="40" TopLine="301"/>
</Position6>
<Position7>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="304" Column="40" TopLine="288"/>
</Position7>
<Position8>
<Filename Value="user_service_intf.pas"/>
<Caret Line="52" Column="3" TopLine="50"/>
</Position8>
<Position9>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<Caret Line="29" Column="12" TopLine="13"/>
</Position10>
<Position11>
<Filename Value="readbuffer_sample.pas"/>
<Caret Line="269" Column="1" TopLine="237"/>
</Position11>
<Position12>
<Filename Value="readbuffer_sample.pas"/>
<Caret Line="27" Column="44" TopLine="14"/>
</Position12>
<Position13>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4431" Column="1" TopLine="4386"/>
</Position13>
<Position14>
<Filename Value="user_service_intf.pas"/>
<Caret Line="273" Column="1" TopLine="267"/>
</Position14>
<Position15>
<Filename Value="readbuffer_sample.pas"/>
<Caret Line="58" Column="18" TopLine="46"/>
</Position15>
<Position16>
<Filename Value="readbuffer_sample.pas"/>
<Caret Line="46" Column="11" TopLine="22"/>
</Position16>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="..\;..\..\;$(LazarusDir)\others_package\synapse\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

269
wst/tags/0.5/samples/user_client_readbuffer/readbuffer_sample.pas Normal file
View File

@ -0,0 +1,269 @@
program readbuffer_sample;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, TypInfo,
user_service_intf_proxy,
synapse_tcp_protocol, synapse_http_protocol, library_protocol,
soap_formatter, binary_formatter,
user_service_intf, xmlrpc_formatter;
type
TUser = TUser_Type;
TUserCategory = TUserCategory_Type;
var
UserServiceInst : UserService;
procedure ShowUser(AUser : TUser);
begin
if ( AUser <> nil ) then begin
WriteLn(' Name = ',AUser.UserName);
WriteLn(' Category = ',GetEnumName(TypeInfo(TUserCategory),Ord(AUser.Category)));
WriteLn(' e-Mail = ',AUser.eMail);
WriteLn(' Preferences = ',AUser.Preferences);
WriteLn(' Note = ',AUser.Note.Data);
{WriteLn(' Author = ',AUser.Note.Author);
WriteLn(' Date = ',AUser.Note.Date);}
end else begin
WriteLn('<Empty User>');
end;
end;
procedure ShowUserArray(AArray : TUserArray);
var
i, c : Integer;
usr : TUser;
begin
if ( AArray <> nil ) then begin
c := AArray.Length;
for i := 0 to Pred(c) do begin
usr := AArray[i];
WriteLn();
WriteLn(Format('User[%d] : ',[(i+1)]));
ShowUser(usr);
end;
end;
end;
procedure HandleShowAll();
var
userArray : TUserArray;
begin
userArray := UserServiceInst.GetList();
try
if ( userArray <> nil ) and ( userArray.Length > 0 ) then begin
ShowUserArray(userArray);
end else begin
WriteLn('Empty Array.');
end;
finally
FreeAndNil(userArray);
end;
end;
type TAddType = ( atAdd, atUpdate );
procedure HandleAdd(const AType :TAddType);
const CAPTIONS : array[TAddType] of string = ( 'Adding a user :', 'Updating a user :' );
function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
begin
Result := '';
Write(APrompt);
ReadLn(Result);
Result := Trim(Result);
if ANonNull and ( Length(Result) = 0 ) then
Raise Exception.Create('Invalid User Name!');
end;
var
usr : TUser;
buff : string;
begin
buff := '';
WriteLn(CAPTIONS[AType]);
try
usr := TUser.Create();
try
usr.UserName := ReadItem('Enter user name : ',True);
buff := UpperCase(ReadItem('Enter user Category( A : Admin; N : normal ) : ',True));
if ( buff[1] = 'A' ) then
usr.Category:= Admin
else
usr.Category:= Normal;
usr.eMail := ReadItem('Enter user e-mail : ',False);
usr.Preferences := ReadItem('Enter user Preferences : ',False);
buff := UpperCase(ReadItem('Do you want to add some notes : ',True));
if ( buff[1] = 'O' ) then begin
usr.Note.Data := ReadItem('Enter user Note : ',False);
{usr.Note.Author := ReadItem('Enter user Note.Author : ',False);
usr.Note.Date := ReadItem('Enter user Note.Date : ',False);}
end;
if ( AType = atUpdate ) then
UserServiceInst.Update(usr)
else
UserServiceInst.Add(usr);
finally
FreeAndNil(usr);
end;
except
on e : Exception do begin
WriteLn(e.Message);
end;
end;
end;
procedure HandleFindUser();
var
user : TUser;
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
user := UserServiceInst.Find(buff);
try
ShowUser(user);
finally
FreeAndNil(user);
end;
end;
procedure HandleDeleteUser();
var
buff : string;
begin
Write('Enter User Name : ');
ReadLn(buff);
UserServiceInst.Delete(buff);
end;
type
TTransportType = ( ttLibrary, ttTCP, ttHTTP );
TFormatType = ( ftBinary, ftSoap, ftXmlRPC );
var
TransportType : TTransportType;
FormatValue : TFormatType;
procedure CreateProxy();
const ADDRESS_MAP : array[TTransportType] of string = (
'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
'TCP:Address=127.0.0.1;Port=1234;target=UserService',
//'http:Address=http://127.0.0.1:8080/wst/services/UserService/?format=soap'
'http:Address=http://127.0.0.1:8000/services/UserService'
);
FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc' );
var
buff : string;
begin
if ( TransportType = ttHTTP ) then
buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
else
buff := ADDRESS_MAP[TransportType];
if ( TransportType = ttLibrary ) then
buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
UserServiceInst := TUserService_Proxy.Create(
'UserService',
FORMAT_MAP[FormatValue] + ':',
buff
);
end;
procedure ReadTransportType();
var
buff : string;
begin
WriteLn();
WriteLn('Select a transport protocol : ');
WriteLn(' L : Library, the lib_server project must have been built');
WriteLn(' T : TCP, the tcp_server must have been built');
WriteLn(' H : HTTP, the http_server must have been built');
WriteLn();
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
case buff[1] of
'L' : TransportType := ttLibrary;
'T' : TransportType := ttTCP;
'H' : TransportType := ttHTTP;
end;
Break;
end;
end;
end;
procedure ReadFormatType();
var
buff : string;
begin
WriteLn();
WriteLn('Select a messaging format : ');
WriteLn(' B : binary ( binary_formatter.pas )');
WriteLn(' S : soap ( soap_formatter.pas )');
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
WriteLn();
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['B','S', 'X'] ) then begin
case buff[1] of
'B' : FormatValue := ftBinary;
'S' : FormatValue := ftSoap;
'X' : FormatValue := ftXmlRPC;
end;
Break;
end;
end;
end;
var
strBuffer : string;
begin
SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport();
WriteLn('Sample Application using Web Services Toolkit');
ReadFormatType();
ReadTransportType();
CreateProxy();
WriteLn('Menu :');
WriteLn(' L : Show the user list');
WriteLn(' A : Add a new user');
WriteLn(' U : Update a user');
WriteLn(' D : Delete a user');
WriteLn(' F : Find a new');
WriteLn(' C : Change the communication protocol');
WriteLn(' Z : Change the messaging format');
WriteLn(' X : Exit');
WriteLn();
Write('Choose a item : ');
while True do begin
strBuffer := '';
ReadLn(strBuffer);
strBuffer := UpperCase(Trim(strBuffer));
if ( Length(strBuffer) > 0 ) then begin
case strBuffer[1] of
'L' : HandleShowAll();
'A' : HandleAdd(atAdd);
'U' : HandleAdd(atUpdate);
'D' : HandleDeleteUser();
'F' : HandleFindUser();
'C' :
begin
ReadTransportType();
CreateProxy();
end;
'Z' :
begin
ReadFormatType();
CreateProxy();
end;
'X' : Break;
end;
WriteLn();
Write('Choose a item : ');
end;
end;
end.

271
wst/tags/0.5/samples/user_client_readbuffer/user_service_intf.pas Normal file
View File

@ -0,0 +1,271 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf".
Date : "12/07/2007 11:50:48".
}
unit user_service_intf;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'urn:UserService';
sUNIT_NAME = 'user_service_intf';
type
TUserArray = class;
TUser_Type = class;
TUserCategory_Type = (
Normal
,Admin
);
{ TUser_Type }
TUser_Type = class(TBaseComplexRemotable)
private
FCategory : TUserCategory_Type;
FUserName : string;
FeMail : string;
FPreferences : string;
FNote : TStringBufferRemotable;
public
constructor Create();override;
destructor Destroy();override;
published
property Category : TUserCategory_Type read FCategory write FCategory;
property UserName : string read FUserName write FUserName;
property eMail : string read FeMail write FeMail;
property Preferences : string read FPreferences write FPreferences;
property Note : TStringBufferRemotable read FNote write FNote;
end;
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TUser_Type;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TUser_Type Read GetItem;Default;
end;
UserService = interface(IInvokable)
['{F49D8FA4-9BBC-4321-9869-5BA745070ABC}']
function GetList():TUserArray;
procedure Add(
const AUser : TUser_Type
);
procedure Update(
const AUser : TUser_Type
);
function Find(
const AName : string
):TUser_Type;
function Delete(
const AName : string
):boolean;
end;
procedure Register_user_service_intf_ServiceMetadata();
Implementation
uses metadata_repository;
{ TUserArray }
function TUserArray.GetItem(AIndex: Integer): TUser_Type;
begin
Result := Inherited GetItem(AIndex) As TUser_Type;
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result:= TUser_Type;
end;
procedure Register_user_service_intf_ServiceMetadata();
var
mm : IModuleMetadataMngr;
begin
mm := GetModuleMetadataMngr();
mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'TRANSPORT_Address',
'http://127.0.0.1:8000/services/UserService'
);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'FORMAT_Style',
'rpc'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'_E_N_',
'GetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceGetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'_E_N_',
'Add'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceAdd'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'_E_N_',
'Update'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceUpdate'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'_E_N_',
'Find'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceFind'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'_E_N_',
'Delete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceDelete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_OutputEncodingStyle',
'literal'
);
end;
{ TUser_Type }
constructor TUser_Type.Create( );
begin
inherited Create( );
FNote := TStringBufferRemotable.Create();
end;
destructor TUser_Type.Destroy( );
begin
FreeAndNil(FNote);
inherited Destroy( );
end;
initialization
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserCategory_Type),'TUserCategory');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUser_Type),'TUser');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserArray),'TUserArray');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TUserArray)].RegisterExternalPropertyName(sARRAY_ITEM,'item');
End.

89
wst/tags/0.5/samples/user_client_readbuffer/user_service_intf.wsdl Normal file
View File

@ -0,0 +1,89 @@
<?xml version="1.0"?>
<definitions name="urn:UserService" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="urn:UserService" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="urn:UserService">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:UserService">
<xsd:complexType name="TUserArray">
<xsd:sequence><xsd:element name="item" type="tns:TUser" maxOccurs="unbounded" minOccurs="0"/></xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TUser">
<xsd:sequence>
<xsd:element name="Category" type="tns:TUserCategory" maxOccurs="1" minOccurs="1"/>
<xsd:element name="UserName" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="eMail" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Preferences" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Note" type="xsd:string" maxOccurs="1" minOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
<xsd:simpleType name="TUserCategory">
<xsd:restriction base="xsd:string">
<xsd:enumeration value="Normal"/>
<xsd:enumeration value="Admin"/>
</xsd:restriction>
</xsd:simpleType>
</xsd:schema>
</types>
<message name="GetList"/>
<message name="GetListResponse"><part name="result" type="tns:TUserArray"/></message>
<message name="Add"><part name="AUser" type="tns:TUser"/></message>
<message name="AddResponse"/>
<message name="Update"><part name="AUser" type="tns:TUser"/></message>
<message name="UpdateResponse"/>
<message name="Find"><part name="AName" type="xsd:string"/></message>
<message name="FindResponse"><part name="result" type="tns:TUser"/></message>
<message name="Delete"><part name="AName" type="xsd:string"/></message>
<message name="DeleteResponse"><part name="result" type="xsd:boolean"/></message>
<portType name="UserService">
<document><GUID value="{F49D8FA4-9BBC-4321-9869-5BA745070ABC}"/></document>
<operation name="GetList">
<input message="tns:GetList"/>
<output message="tns:GetListResponse"/>
</operation>
<operation name="Add">
<input message="tns:Add"/>
<output message="tns:AddResponse"/>
</operation>
<operation name="Update">
<input message="tns:Update"/>
<output message="tns:UpdateResponse"/>
</operation>
<operation name="Find">
<input message="tns:Find"/>
<output message="tns:FindResponse"/>
</operation>
<operation name="Delete">
<input message="tns:Delete"/>
<output message="tns:DeleteResponse"/>
</operation>
</portType>
<binding name="UserServiceBinding" type="tns:UserService">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="GetList">
<soap:operation soapAction="urn:UserService/UserServiceGetList"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Add">
<soap:operation soapAction="urn:UserService/UserServiceAdd"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Update">
<soap:operation soapAction="urn:UserService/UserServiceUpdate"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Find">
<soap:operation soapAction="urn:UserService/UserServiceFind"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Delete">
<soap:operation soapAction="urn:UserService/UserServiceDelete"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
</binding>
<service name="UserService">
<port name="UserServicePort" binding="tns:UserServiceBinding"><soap:address location="http://127.0.0.1:8000/services/UserService"/></port>
</service>
</definitions>

9
wst/tags/0.5/samples/user_client_readbuffer/user_service_intf.wst Normal file
View File

@ -0,0 +1,9 @@
GetWSTResourceManager().AddResource('USER_SERVICE_INTF',
#0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#17'user_service_intf'#1#0#0#0#11'UserS'
+'ervice'#5#0#0#0#7'GetList'#1#0#0#0#6'result'#0#0#0#10'TUserArray'#0#0#0#0#0
+#0#0#3#0#0#0#3'Add'#1#0#0#0#5'AUser'#0#0#0#5'TUser'#0#0#0#0#0#0#0#1#0#0#0#6'U'
+'pdate'#1#0#0#0#5'AUser'#0#0#0#5'TUser'#0#0#0#0#0#0#0#1#0#0#0#4'Find'#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#5'TUser'#0#0
+#0#0#0#0#0#3#0#0#0#6'Delete'#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#7'boolean'#0#0#0#0#0#0#0#3''
);

175
wst/tags/0.5/samples/user_client_readbuffer/user_service_intf_proxy.pas Normal file
View File

@ -0,0 +1,175 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_proxy".
Date : "12/07/2007 11:50:48".
}
Unit user_service_intf_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, user_service_intf;
Type
TUserService_Proxy=class(TBaseProxy,UserService)
Protected
class function GetServiceType() : PTypeInfo;override;
function GetList():TUserArray;
procedure Add(
const AUser : TUser_Type
);
procedure Update(
const AUser : TUser_Type
);
function Find(
const AName : string
):TUser_Type;
function Delete(
const AName : string
):boolean;
End;
Function wst_CreateInstance_UserService(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'):UserService;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_UserService(const AFormat : string; const ATransport : string):UserService;
Begin
Result := TUserService_Proxy.Create('UserService',AFormat+GetServiceDefaultFormatProperties(TypeInfo(UserService)),ATransport + 'address=' + GetServiceDefaultAddress(TypeInfo(UserService)));
End;
{ TUserService_Proxy implementation }
class function TUserService_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(UserService);
end;
function TUserService_Proxy.GetList():TUserArray;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('GetList', GetTarget(),(Self as ICallContext));
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'result';
locSerializer.Get(TypeInfo(TUserArray), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Add(
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Update(
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Update', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Find(
const AName : string
):TUser_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Find', GetTarget(),(Self as ICallContext));
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'result';
locSerializer.Get(TypeInfo(TUser_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Delete(
const AName : string
):boolean;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Delete', GetTarget(),(Self as ICallContext));
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(boolean), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i user_service_intf.wst}
{$IF DECLARED(Register_user_service_intf_ServiceMetadata)}
Register_user_service_intf_ServiceMetadata();
{$IFEND}
End.

284
wst/tags/0.5/samples/user_service_intf.pas Normal file
View File

@ -0,0 +1,284 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf".
Date : "14/08/2007 21:45:00".
}
unit user_service_intf;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'urn:UserService';
sUNIT_NAME = 'user_service_intf';
type
TUserArray = class;
TUser_Type = class;
TNote_Type = class;
TUserCategory_Type = (
Normal
,Admin
);
TUser_Type = class(TBaseComplexRemotable)
private
FCategory : TUserCategory_Type;
FUserName : string;
FeMail : string;
FPreferences : string;
FNote : TNote_Type;
public
constructor Create();override;
destructor Destroy();override;
published
property Category : TUserCategory_Type read FCategory write FCategory;
property UserName : string read FUserName write FUserName;
property eMail : string read FeMail write FeMail;
property Preferences : string read FPreferences write FPreferences;
property Note : TNote_Type read FNote write FNote;
end;
TNote_Type = class(TBaseComplexRemotable)
private
FHeader : string;
FAuthor : string;
FDate : string;
published
property Header : string read FHeader write FHeader;
property Author : string read FAuthor write FAuthor;
property Date : string read FDate write FDate;
end;
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TUser_Type;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TUser_Type Read GetItem;Default;
end;
UserService = interface(IInvokable)
['{F49D8FA4-9BBC-4321-9869-5BA745070ABC}']
function GetList():TUserArray;
procedure Add(
const AUser : TUser_Type
);
procedure Update(
const AUser : TUser_Type
);
function Find(
const AName : string
):TUser_Type;
function Delete(
const AName : string
):boolean;
end;
procedure Register_user_service_intf_ServiceMetadata();
Implementation
uses metadata_repository;
{ TUser_Type }
constructor TUser_Type.Create();
begin
inherited Create();
FNote := TNote_Type.Create();
end;
destructor TUser_Type.Destroy();
begin
if Assigned(FNote) then
FreeAndNil(FNote);
inherited Destroy();
end;
{ TUserArray }
function TUserArray.GetItem(AIndex: Integer): TUser_Type;
begin
Result := Inherited GetItem(AIndex) As TUser_Type;
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result:= TUser_Type;
end;
procedure Register_user_service_intf_ServiceMetadata();
var
mm : IModuleMetadataMngr;
begin
mm := GetModuleMetadataMngr();
mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'TRANSPORT_Address',
'http://127.0.0.1:8000/services/UserService'
);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'FORMAT_Style',
'rpc'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'_E_N_',
'GetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceGetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'_E_N_',
'Add'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceAdd'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'_E_N_',
'Update'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceUpdate'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'_E_N_',
'Find'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceFind'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'_E_N_',
'Delete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceDelete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_OutputEncodingStyle',
'literal'
);
end;
initialization
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserCategory_Type),'TUserCategory');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUser_Type),'TUser');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TNote_Type),'TNote');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserArray),'TUserArray');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TUserArray)].RegisterExternalPropertyName(sARRAY_ITEM,'item');
End.

96
wst/tags/0.5/samples/user_service_intf.wsdl Normal file
View File

@ -0,0 +1,96 @@
<?xml version="1.0"?>
<definitions name="urn:UserService" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="urn:UserService" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="urn:UserService">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:UserService">
<xsd:complexType name="TUserArray">
<xsd:sequence><xsd:element name="item" type="tns:TUser" maxOccurs="unbounded" minOccurs="0"/></xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TUser">
<xsd:sequence>
<xsd:element name="Category" type="tns:TUserCategory" maxOccurs="1" minOccurs="1"/>
<xsd:element name="UserName" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="eMail" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Preferences" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Note" type="tns:TNote" maxOccurs="1" minOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
<xsd:simpleType name="TUserCategory">
<xsd:restriction base="xsd:string">
<xsd:enumeration value="Normal"/>
<xsd:enumeration value="Admin"/>
</xsd:restriction>
</xsd:simpleType>
<xsd:complexType name="TNote">
<xsd:sequence>
<xsd:element name="Header" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Author" type="xsd:string" maxOccurs="1" minOccurs="1"/>
<xsd:element name="Date" type="xsd:string" maxOccurs="1" minOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
<message name="GetList"/>
<message name="GetListResponse"><part name="result" type="tns:TUserArray"/></message>
<message name="Add"><part name="AUser" type="tns:TUser"/></message>
<message name="AddResponse"/>
<message name="Update"><part name="AUser" type="tns:TUser"/></message>
<message name="UpdateResponse"/>
<message name="Find"><part name="AName" type="xsd:string"/></message>
<message name="FindResponse"><part name="result" type="tns:TUser"/></message>
<message name="Delete"><part name="AName" type="xsd:string"/></message>
<message name="DeleteResponse"><part name="result" type="xsd:boolean"/></message>
<portType name="UserService">
<document><GUID value="{F49D8FA4-9BBC-4321-9869-5BA745070ABC}"/></document>
<operation name="GetList">
<input message="tns:GetList"/>
<output message="tns:GetListResponse"/>
</operation>
<operation name="Add">
<input message="tns:Add"/>
<output message="tns:AddResponse"/>
</operation>
<operation name="Update">
<input message="tns:Update"/>
<output message="tns:UpdateResponse"/>
</operation>
<operation name="Find">
<input message="tns:Find"/>
<output message="tns:FindResponse"/>
</operation>
<operation name="Delete">
<input message="tns:Delete"/>
<output message="tns:DeleteResponse"/>
</operation>
</portType>
<binding name="UserServiceBinding" type="tns:UserService">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="GetList">
<soap:operation soapAction="urn:UserService/UserServiceGetList"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Add">
<soap:operation soapAction="urn:UserService/UserServiceAdd"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Update">
<soap:operation soapAction="urn:UserService/UserServiceUpdate"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Find">
<soap:operation soapAction="urn:UserService/UserServiceFind"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
<operation name="Delete">
<soap:operation soapAction="urn:UserService/UserServiceDelete"/>
<input><soap:body use="literal" namespace="urn:UserService"/></input>
<output><soap:body use="literal" namespace="urn:UserService"/></output>
</operation>
</binding>
<service name="UserService">
<port name="UserServicePort" binding="tns:UserServiceBinding"><soap:address location="http://127.0.0.1:8000/services/UserService"/></port>
</service>
</definitions>

75
wst/tags/0.5/samples/user_service_intf_.pas Normal file
View File

@ -0,0 +1,75 @@
unit user_service_intf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, base_service_intf;
type
TUserCategory = ( Normal, Admin );
{ TUser }
TUser = class(TBaseComplexRemotable)
private
FCategory: TUserCategory;
FeMail: string;
FName: string;
FPreferences: string;
published
property Category : TUserCategory read FCategory write FCategory;
property Name : string read FName write FName;
property eMail : string read FeMail write FeMail;
property Preferences : string read FPreferences write FPreferences;
end;
{ TUserArray }
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetUser(AIndex: Integer): TUser;
public
class function GetItemClass():TBaseRemotableClass;override;
Property Item[AIndex:Integer] : TUser Read GetUser;Default;
End;
UserService = interface(IInvokable)
['{101F2CA7-19FC-4A73-AA98-F13FCDA75EE1}']
function GetList():TUserArray;
procedure Add(AUser : TUser);
function Find(const AName : string):TUser;
function Delete(const AName : string):Boolean;
end;
procedure Register_user_service_intf_NameSpace();
implementation
uses metadata_repository;
procedure Register_user_service_intf_NameSpace();
begin
GetModuleMetadataMngr().SetRepositoryNameSpace('user_service_intf','urn:UserService');
end;
{ TUserArray }
function TUserArray.GetUser(AIndex: Integer): TUser;
begin
Result := GetItem(AIndex) as TUser;
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result := TUser;
end;
initialization
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUserCategory),'TUserCategory');
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUser),'TUser');
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUserArray),'TUserArray');
end.

293
wst/tags/0.5/samples/user_service_intf_binder.pas Normal file
View File

@ -0,0 +1,293 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_binder".
Date : "16/07/2007 19:01:46".
}
unit user_service_intf_binder;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, base_service_intf, server_service_intf, user_service_intf;
type
TUserService_ServiceBinder = class(TBaseServiceBinder)
protected
procedure GetListHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure UpdateHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure FindHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure DeleteHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
public
constructor Create();
end;
TUserService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
private
FInstance : IInterface;
protected
function CreateInstance():IInterface;
public
constructor Create();
destructor Destroy();override;
end;
procedure Server_service_RegisterUserServiceService();
Implementation
uses TypInfo, wst_resources_imp,metadata_repository;
{ TUserService_ServiceBinder implementation }
procedure TUserService_ServiceBinder.GetListHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
returnVal : TUserArray;
begin
callCtx := AContext;
TObject(returnVal) := nil;
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.GetList();
if Assigned(TObject(returnVal)) then
callCtx.AddObjectToFree(TObject(returnVal));
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(TUserArray),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AUser : TUser_Type;
begin
callCtx := AContext;
TObject(AUser) := nil;
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser_Type),strPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Add(AUser);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.UpdateHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AUser : TUser_Type;
begin
callCtx := AContext;
TObject(AUser) := nil;
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser_Type),strPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Update(AUser);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.FindHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AName : string;
returnVal : TUser_Type;
begin
callCtx := AContext;
TObject(returnVal) := nil;
strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Find(AName);
if Assigned(TObject(returnVal)) then
callCtx.AddObjectToFree(TObject(returnVal));
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(TUser_Type),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.DeleteHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AName : string;
returnVal : boolean;
begin
callCtx := AContext;
strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Delete(AName);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(boolean),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
constructor TUserService_ServiceBinder.Create();
begin
inherited Create(GetServiceImplementationRegistry().FindFactory('UserService'));
RegisterVerbHandler('GetList',{$IFDEF FPC}@{$ENDIF}GetListHandler);
RegisterVerbHandler('Add',{$IFDEF FPC}@{$ENDIF}AddHandler);
RegisterVerbHandler('Update',{$IFDEF FPC}@{$ENDIF}UpdateHandler);
RegisterVerbHandler('Find',{$IFDEF FPC}@{$ENDIF}FindHandler);
RegisterVerbHandler('Delete',{$IFDEF FPC}@{$ENDIF}DeleteHandler);
end;
{ TUserService_ServiceBinderFactory }
function TUserService_ServiceBinderFactory.CreateInstance():IInterface;
begin
Result := FInstance;
end;
constructor TUserService_ServiceBinderFactory.Create();
begin
FInstance := TUserService_ServiceBinder.Create() as IInterface;
end;
destructor TUserService_ServiceBinderFactory.Destroy();
begin
FInstance := nil;
inherited Destroy();
end;
procedure Server_service_RegisterUserServiceService();
Begin
GetServerServiceRegistry().Register('UserService',TUserService_ServiceBinderFactory.Create() as IItemFactory);
End;
initialization
{$i user_service_intf.wst}
{$IF DECLARED(Register_user_service_intf_ServiceMetadata)}
Register_user_service_intf_ServiceMetadata();
{$IFEND}
End.

236
wst/tags/0.5/samples/user_service_intf_imp.pas Normal file
View File

@ -0,0 +1,236 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_imp".
Date : "30/04/2007 00:07".
}
Unit user_service_intf_imp;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes,
base_service_intf, server_service_intf, server_service_imputils,
user_service_intf, cursor_intf;
Type
TUser = TUser_Type;
{ TUserService_ServiceImp }
TUserService_ServiceImp=class(TActivableServiceImplementation,UserService)
protected
procedure Activate();override;
procedure Deactivate();override;
function CanBePooled() : Boolean;override;
Protected
function GetList():TUserArray;
procedure Add(
Const AUser : TUser
);
procedure Update(
Const AUser : TUser
);
function Find(
Const AName : string
):TUser;
function Delete(
Const AName : string
):boolean;
public
constructor Create();override;
destructor Destroy();override;
End;
const sDATA_FILE_NAME = 'sample.data';
procedure RegisterUserServiceImplementationFactory();
procedure SaveDataToFile(const AFileName : string);
Implementation
uses Contnrs, std_cursors, rtti_filters, imp_helper, config_objects;
var
FUserList : TObjectList = nil;
FUserCursor : IObjectCursor = nil;
procedure FillArrayFromCursor(ACursor: IObjectCursor;ARes: TUserArray);
var
i, c : Integer;
begin
ACursor.Reset();
c := 0;
while ACursor.MoveNext() do begin
Inc(c);
end;
ARes.SetLength(c);
i := 0;
ACursor.Reset();
while ACursor.MoveNext() do begin
ARes[i].Assign(ACursor.GetCurrent() as TUser);
Inc(i);
end;
end;
{ TUserService_ServiceImp implementation }
function TUserService_ServiceImp.GetList():TUserArray;
Begin
Result := TUserArray.Create();
try
FillArrayFromCursor(FUserCursor.Clone() as IObjectCursor,Result);
except
FreeAndNil(Result);
raise;
end;
SaveDataToFile(sDATA_FILE_NAME);
End;
procedure TUserService_ServiceImp.Add(Const AUser : TUser);
var
locObj : TUser;
Begin
locObj := Find(AUser.UserName);
if ( locObj <> nil ) then
raise Exception.CreateFmt('Duplicated user : "%s"',[AUser.UserName]);
locObj := TUser.Create();
locObj.Assign(AUser);
FUserList.Add(locObj);
End;
procedure TUserService_ServiceImp.Update(const AUser: TUser);
var
locCrs : IObjectCursor;
Begin
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AUser.UserName)]),TUser));
if locCrs.MoveNext() then begin
(locCrs.GetCurrent() as TUser).Assign(AUser);
end;
end;
function TUserService_ServiceImp.Find(Const AName : string):TUser;
var
locCrs : IObjectCursor;
Begin
Result := nil;
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AName)]),TUser));
if locCrs.MoveNext() then begin
Result := TUser.Create();
Result.Assign(locCrs.GetCurrent() as TUser);
end;
End;
function TUserService_ServiceImp.Delete(Const AName : string):boolean;
var
locCrs : IObjectCursor;
Begin
Result := False;
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AName)]),TUser));
if locCrs.MoveNext() then begin
FUserList.Delete(FUserList.IndexOf(locCrs.GetCurrent() as TUser));
Result := True;
end;
End;
procedure RegisterUserServiceImplementationFactory();
Begin
GetServiceImplementationRegistry().Register('UserService',TImplementationFactory.Create(TUserService_ServiceImp,wst_GetServiceConfigText('UserService')) as IServiceImplementationFactory);
End;
procedure FillSampleData();
var
locUser : TUser;
begin
locUser := TUser.Create();
locUser.UserName := 'Lazarus FreePascal';
locUser.eMail := 'Lazarus@FreePascal.wst';
FUserList.Add(locUser);
locUser := TUser.Create();
locUser.UserName := 'Inoussa OUEDRAOGO';
locUser.eMail := 'sample@example.wst';
FUserList.Add(locUser);
end;
procedure FillDataFromFile(const AFileName : string);
var
objArray : TUserArray;
i : PtrInt;
obj : TUser;
begin
objArray := TUserArray.Create();
try
LoadObjectFromFile(objArray,AFileName);
FUserList.Clear();
for i := 0 to Pred(objArray.Length) do begin
obj := TUser.Create();
FUserList.Add(obj);
obj.Assign(objArray[i]);
end;
finally
FreeAndNil(objArray);
end;
end;
procedure SaveDataToFile(const AFileName : string);
var
objArray : TUserArray;
begin
objArray := TUserArray.Create();
try
FUserCursor.Reset();
FillArrayFromCursor(FUserCursor,objArray);
SaveObjectToFile(objArray,AFileName);
finally
FreeAndNil(objArray);
end;
end;
constructor TUserService_ServiceImp.Create;
begin
inherited;
WriteLn('TUserService_ServiceImp.Create();');
end;
procedure TUserService_ServiceImp.Activate;
begin
inherited;
WriteLn(Format('TUserService_ServiceImp.Activate(), Self = %p',[Pointer(Self)]));
end;
function TUserService_ServiceImp.CanBePooled: Boolean;
begin
Result := True;
end;
procedure TUserService_ServiceImp.Deactivate;
begin
WriteLn(Format('TUserService_ServiceImp.Deactivate(), Self = %p',[Pointer(Self)]));
inherited;
end;
destructor TUserService_ServiceImp.Destroy;
begin
WriteLn('TUserService_ServiceImp.Destroy();');
inherited;
end;
initialization
FUserList := TObjectList.Create(True);
FUserCursor := TObjectListCursor.Create(FUserList);
if FileExists(sDATA_FILE_NAME) then
FillDataFromFile(sDATA_FILE_NAME)
else
FillSampleData();
finalization
if Assigned(FUserCursor) then
SaveDataToFile(sDATA_FILE_NAME);
FUserCursor := nil;
FreeAndNil(FUserList);
end.

175
wst/tags/0.5/samples/user_service_intf_proxy.pas Normal file
View File

@ -0,0 +1,175 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_proxy".
Date : "14/08/2007 21:45:00".
}
Unit user_service_intf_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, user_service_intf;
Type
TUserService_Proxy=class(TBaseProxy,UserService)
Protected
class function GetServiceType() : PTypeInfo;override;
function GetList():TUserArray;
procedure Add(
const AUser : TUser_Type
);
procedure Update(
const AUser : TUser_Type
);
function Find(
const AName : string
):TUser_Type;
function Delete(
const AName : string
):boolean;
End;
Function wst_CreateInstance_UserService(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'):UserService;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_UserService(const AFormat : string; const ATransport : string):UserService;
Begin
Result := TUserService_Proxy.Create('UserService',AFormat+GetServiceDefaultFormatProperties(TypeInfo(UserService)),ATransport + 'address=' + GetServiceDefaultAddress(TypeInfo(UserService)));
End;
{ TUserService_Proxy implementation }
class function TUserService_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(UserService);
end;
function TUserService_Proxy.GetList():TUserArray;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('GetList', GetTarget(),(Self as ICallContext));
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'result';
locSerializer.Get(TypeInfo(TUserArray), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Add(
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Update(
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Update', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Find(
const AName : string
):TUser_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Find', GetTarget(),(Self as ICallContext));
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'result';
locSerializer.Get(TypeInfo(TUser_Type), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Delete(
const AName : string
):boolean;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Delete', GetTarget(),(Self as ICallContext));
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(boolean), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i user_service_intf.wst}
{$IF DECLARED(Register_user_service_intf_ServiceMetadata)}
Register_user_service_intf_ServiceMetadata();
{$IFEND}
End.

Some files were not shown because too many files have changed in this diff Show More