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

Soap header sample : client and server. See readme.txt for more informations.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@536 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-08-27 17:50:39 +00:00
parent 82d0c2a1c1
commit bfbb77cd0b
14 changed files with 1178 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

82
wst/trunk/samples/soap_headers/calcservice.wsdl Normal file
View File

@ -0,0 +1,82 @@
<?xml version="1.0"?>
<definitions name="urn:calc-service" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="urn:calc-service" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="urn:calc-service">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:tns="urn:calc-service" xmlns:wst="urn:wst_base" targetNamespace="urn:calc-service">
<xsd:complexType name="TLoginHeader" wst:wst_headerBlock="true">
<xsd:annotation>
<xsd:documentation>The TLoginHeader class is used by the client for its first invocation of the service.
At the first response the server sends a TSessionHeader instance that contains a
session token. The others time the client invokes the server the client have to
send the session token using the TSessionHeader class.
</xsd:documentation>
</xsd:annotation>
<xsd:sequence>
<xsd:element name="UserName" type="xsd:string"/>
<xsd:element name="Password" type="xsd:string"/>
</xsd:sequence>
</xsd:complexType>
<xsd:complexType name="TSessionHeader" wst:wst_headerBlock="true">
<xsd:annotation>
<xsd:documentation>This header class is used by the client to send its session token to the server.
</xsd:documentation>
</xsd:annotation>
<xsd:sequence>
<xsd:element name="SessionToken" type="xsd:string"/>
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
<message name="Add">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
</message>
<message name="AddResponse">
<part name="result" type="xsd:int"/>
</message>
<message name="Substract">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
</message>
<message name="SubstractResponse">
<part name="result" type="xsd:int"/>
</message>
<portType name="ICalcService">
<document>
<GUID value="{090EADB7-6B25-4F35-9419-2AF113D44BF8}"/>
</document>
<operation name="Add">
<input message="tns:Add"/>
<output message="tns:AddResponse"/>
</operation>
<operation name="Substract">
<input message="tns:Substract"/>
<output message="tns:SubstractResponse"/>
</operation>
</portType>
<binding name="ICalcServiceBinding" type="tns:ICalcService">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="Add">
<soap:operation soapAction=""/>
<input>
<soap:body use="literal" namespace="urn:calc-service"/>
</input>
<output>
<soap:body use="literal" namespace="urn:calc-service"/>
</output>
</operation>
<operation name="Substract">
<soap:operation soapAction=""/>
<input>
<soap:body use="literal" namespace="urn:calc-service"/>
</input>
<output>
<soap:body use="literal" namespace="urn:calc-service"/>
</output>
</operation>
</binding>
<service name="ICalcService">
<port name="ICalcServicePort" binding="tns:ICalcServiceBinding">
<soap:address location="http://127.0.0.1:8000/services/ICalcService"/>
</port>
</service>
</definitions>

141
wst/trunk/samples/soap_headers/client/calcservice.pas Normal file
View File

@ -0,0 +1,141 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice".
Date : "27/08/2008 17:12:53".
}
unit calcservice;
{$IFDEF FPC}
{$mode objfpc} {$H+}
{$ENDIF}
{$IFNDEF FPC}
{$DEFINE WST_RECORD_RTTI}
{$ENDIF}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'urn:calc-service';
sUNIT_NAME = 'calcservice';
type
TLoginHeader = class;
TSessionHeader = class;
{ TLoginHeader
The TLoginHeader class is used by the client for its first invocation of the service.
At the first response the server sends a TSessionHeader instance that contains a
session token. The others time the client invokes the server the client have to
send the session token using the TSessionHeader class.
}
TLoginHeader = class(THeaderBlock)
private
FUserName : string;
FPassword : string;
published
property UserName : string read FUserName write FUserName;
property Password : string read FPassword write FPassword;
end;
{ TSessionHeader
This header class is used by the client to send its session token to the server.
}
TSessionHeader = class(THeaderBlock)
private
FSessionToken : string;
published
property SessionToken : string read FSessionToken write FSessionToken;
end;
ICalcService = interface(IInvokable)
['{090EADB7-6B25-4F35-9419-2AF113D44BF8}']
function Add(
const A : integer;
const B : integer
):integer;
function Substract(
const A : integer;
const B : integer
):integer;
end;
procedure Register_calcservice_ServiceMetadata();
Implementation
uses metadata_repository, record_rtti, wst_types;
procedure Register_calcservice_ServiceMetadata();
var
mm : IModuleMetadataMngr;
begin
mm := GetModuleMetadataMngr();
mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
mm.SetServiceCustomData(
sUNIT_NAME,
'ICalcService',
'TRANSPORT_Address',
'http://127.0.0.1:8000/services/ICalcService'
);
mm.SetServiceCustomData(
sUNIT_NAME,
'ICalcService',
'FORMAT_Style',
'rpc'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'_E_N_',
'Add'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'_E_N_',
'Substract'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'FORMAT_OutputEncodingStyle',
'literal'
);
end;
initialization
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TLoginHeader),'TLoginHeader');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TSessionHeader),'TSessionHeader');
End.

8
wst/trunk/samples/soap_headers/client/calcservice.wst Normal file
View File

@ -0,0 +1,8 @@
GetWSTResourceManager().AddResource('CALCSERVICE',
#0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#11'calcservice'#1#0#0#0#12'ICalcServic'
+'e'#2#0#0#0#3'Add'#3#0#0#0#1'A'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0
+#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#7'integer'#0#0#0#0#0#0
+#0#3#0#0#0#9'Substract'#3#0#0#0#1'A'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#1
+'B'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#7'integer'#0#0#0#0
+#0#0#0#3''
);

107
wst/trunk/samples/soap_headers/client/calcservice_proxy.pas Normal file
View File

@ -0,0 +1,107 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice_proxy".
Date : "27/08/2008 17:12:53".
}
Unit calcservice_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, calcservice;
Type
TCalcService_Proxy=class(TBaseProxy,ICalcService)
Protected
class function GetServiceType() : PTypeInfo;override;
function Add(
const A : integer;
const B : integer
):integer;
function Substract(
const A : integer;
const B : integer
):integer;
End;
Function wst_CreateInstance_ICalcService(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'):ICalcService;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_ICalcService(const AFormat : string; const ATransport : string):ICalcService;
Begin
Result := TCalcService_Proxy.Create('ICalcService',AFormat+GetServiceDefaultFormatProperties(TypeInfo(ICalcService)),ATransport + 'address=' + GetServiceDefaultAddress(TypeInfo(ICalcService)));
End;
{ TCalcService_Proxy implementation }
class function TCalcService_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(ICalcService);
end;
function TCalcService_Proxy.Add(
const A : integer;
const B : integer
):integer;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('A', TypeInfo(integer), A);
locSerializer.Put('B', TypeInfo(integer), B);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(integer), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TCalcService_Proxy.Substract(
const A : integer;
const B : integer
):integer;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Substract', GetTarget(),(Self as ICallContext));
locSerializer.Put('A', TypeInfo(integer), A);
locSerializer.Put('B', TypeInfo(integer), B);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(integer), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i calcservice.wst}
{$IF DECLARED(Register_calcservice_ServiceMetadata)}
Register_calcservice_ServiceMetadata();
{$IFEND}
End.

76
wst/trunk/samples/soap_headers/client/client_calc.lpi Normal file
View File

@ -0,0 +1,76 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<Title Value="Web Service Toolkit - &quot;CalcService&quot; client sample"/>
</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="3">
<Unit0>
<Filename Value="client_calc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="client_calc"/>
</Unit0>
<Unit1>
<Filename Value="calcservice.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice"/>
</Unit1>
<Unit2>
<Filename Value="calcservice_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice_proxy"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="client_calc"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\..\"/>
<OtherUnitFiles Value="..\..\..\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

86
wst/trunk/samples/soap_headers/client/client_calc.pas Normal file
View File

@ -0,0 +1,86 @@
program client_calc;
{$mode objfpc}{$H+}
uses
Classes, SysUtils,
soap_formatter, synapse_http_protocol,
calcservice, calcservice_proxy, base_service_intf;
var
theProxy : ICalcService;
callContext : ICallContext;
loginHeader : TLoginHeader;
sessionHeader : TSessionHeader;
sessionToken : string;
procedure PrepareAndSendSessionHeader();
var
k, c : Integer;
begin
callContext := theProxy as ICallContext;
c := callContext.GetHeaderCount(AllHeaderDirection);
if ( c > 0 ) then begin
for k := 0 to Pred(c) do begin
if callContext.GetHeader(k).InheritsFrom(TSessionHeader) then begin
sessionToken := TSessionHeader(callContext.GetHeader(k)).SessionToken;
Writeln; WriteLn(' Your session token is : ',sessionToken); WriteLn;
sessionHeader := TSessionHeader.Create();
sessionHeader.SessionToken := sessionToken;
// Delete the Login Header
callContext.ClearHeaders(hdOut);
loginHeader := nil{the object no longer exists};
//Add the session token
callContext.AddHeader(sessionHeader,True{Let the CallContext free the object});
Break;
end;
end;
end;
end;
var
a, b : Integer;
op, c : Char;
strBuffer : string;
begin
SYNAPSE_RegisterHTTP_Transport();
theProxy := wst_CreateInstance_ICalcService();
loginHeader := TLoginHeader.Create();
WriteLn('Calculator Client demo');
Write(' Enter your user name : ');
ReadLn(strBuffer);
loginHeader.UserName := strBuffer;
Write(' Enter your password : ');
ReadLn(strBuffer);
loginHeader.Password := strBuffer;
WriteLn();
sessionHeader := nil;
try
repeat
if ( sessionHeader = nil ) then begin
// login the first time
loginHeader.mustUnderstand := 1;
loginHeader.Direction := hdOut;
(theProxy as ICallContext).AddHeader(loginHeader,True{Let the CallContext free the object});
end;
Write('Enter first operand : '); ReadLn(a);
Write('Enter second operand : '); ReadLn(b);
Write('Enter operator ( + or - ) : '); ReadLn(op);
case op of
'+' : WriteLn(a,' + ',b,' = ',theProxy.Add(a,b));
'-' : WriteLn(a,' - ',b,' = ',theProxy.Substract(a,b));
else WriteLn('Unknown operator : ',op);
end;
if ( sessionHeader = nil ) then begin
{Now prepare the session header}
PrepareAndSendSessionHeader();
end;
WriteLn(''); Write(' Continue (y/n) ? : '); ReadLn(c);
WriteLn('')
until ( c <> 'y' );
except
on e : Exception do begin
WriteLn;
WriteLn('An exception occurs >> ');
Write(e.Message);
end;
end;
end.

20
wst/trunk/samples/soap_headers/readme.txt Normal file
View File

@ -0,0 +1,20 @@
Web Services Toolkit Soap headers sample
========================================
This sample presents server side and client header management.
Use Case :
The first time the client connect to the server, the client
send its user name and password using the TLoginHeader class.
The server accepts the client and returns a session token that
should be used by the client for its next invocations. The
server uses the TSessionHeader class to return the session
token.
The client uses the server's returned session token for its
next calls to the server.
Note : Define the LOG_TO_FILE symbol {$DEFINE LOG_TO_FILE} in
the server program to log the exchanged messages of the
communication with clients.

141
wst/trunk/samples/soap_headers/server/calcservice.pas Normal file
View File

@ -0,0 +1,141 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice".
Date : "27/08/2008 16:47:32".
}
unit calcservice;
{$IFDEF FPC}
{$mode objfpc} {$H+}
{$ENDIF}
{$IFNDEF FPC}
{$DEFINE WST_RECORD_RTTI}
{$ENDIF}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'urn:calc-service';
sUNIT_NAME = 'calcservice';
type
TLoginHeader = class;
TSessionHeader = class;
{ TLoginHeader
The TLoginHeader class is used by the client for its first invocation of the service.
At the first response the server sends a TSessionHeader instance that contains a
session token. The others time the client invokes the server the client have to
send the session token using the TSessionHeader class.
}
TLoginHeader = class(THeaderBlock)
private
FUserName : string;
FPassword : string;
published
property UserName : string read FUserName write FUserName;
property Password : string read FPassword write FPassword;
end;
{ TSessionHeader
This header class is used by the client to send its session token to the server.
}
TSessionHeader = class(THeaderBlock)
private
FSessionToken : string;
published
property SessionToken : string read FSessionToken write FSessionToken;
end;
ICalcService = interface(IInvokable)
['{090EADB7-6B25-4F35-9419-2AF113D44BF8}']
function Add(
const A : integer;
const B : integer
):integer;
function Substract(
const A : integer;
const B : integer
):integer;
end;
procedure Register_calcservice_ServiceMetadata();
Implementation
uses metadata_repository, record_rtti, wst_types;
procedure Register_calcservice_ServiceMetadata();
var
mm : IModuleMetadataMngr;
begin
mm := GetModuleMetadataMngr();
mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
mm.SetServiceCustomData(
sUNIT_NAME,
'ICalcService',
'TRANSPORT_Address',
'http://127.0.0.1:8000/services/ICalcService'
);
mm.SetServiceCustomData(
sUNIT_NAME,
'ICalcService',
'FORMAT_Style',
'rpc'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'_E_N_',
'Add'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Add',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'_E_N_',
'Substract'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'ICalcService',
'Substract',
'FORMAT_OutputEncodingStyle',
'literal'
);
end;
initialization
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TLoginHeader),'TLoginHeader');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TSessionHeader),'TSessionHeader');
End.

8
wst/trunk/samples/soap_headers/server/calcservice.wst Normal file
View File

@ -0,0 +1,8 @@
GetWSTResourceManager().AddResource('CALCSERVICE',
#0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#11'calcservice'#1#0#0#0#12'ICalcServic'
+'e'#2#0#0#0#3'Add'#3#0#0#0#1'A'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0
+#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#7'integer'#0#0#0#0#0#0
+#0#3#0#0#0#9'Substract'#3#0#0#0#1'A'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#1
+'B'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#7'integer'#0#0#0#0
+#0#0#0#3''
);

165
wst/trunk/samples/soap_headers/server/calcservice_binder.pas Normal file
View File

@ -0,0 +1,165 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice_binder".
Date : "27/08/2008 16:47:32".
}
unit calcservice_binder;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, base_service_intf, server_service_intf, calcservice;
type
TCalcService_ServiceBinder = class(TBaseServiceBinder)
protected
procedure AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure SubstractHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
public
constructor Create();
end;
TCalcService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
private
FInstance : IInterface;
protected
function CreateInstance():IInterface;
public
constructor Create();
destructor Destroy();override;
end;
procedure Server_service_RegisterCalcServiceService();
Implementation
uses TypInfo, wst_resources_imp,metadata_repository;
{ TCalcService_ServiceBinder implementation }
procedure TCalcService_ServiceBinder.AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : ICalcService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
A : integer;
B : integer;
returnVal : integer;
begin
callCtx := AContext;
strPrmName := 'A'; AFormatter.Get(TypeInfo(integer),strPrmName,A);
strPrmName := 'B'; AFormatter.Get(TypeInfo(integer),strPrmName,B);
tmpObj := Self.GetFactory().CreateInstance() as ICalcService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Add(A,B);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(integer),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TCalcService_ServiceBinder.SubstractHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : ICalcService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
A : integer;
B : integer;
returnVal : integer;
begin
callCtx := AContext;
strPrmName := 'A'; AFormatter.Get(TypeInfo(integer),strPrmName,A);
strPrmName := 'B'; AFormatter.Get(TypeInfo(integer),strPrmName,B);
tmpObj := Self.GetFactory().CreateInstance() as ICalcService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Substract(A,B);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(integer),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
constructor TCalcService_ServiceBinder.Create();
begin
inherited Create(GetServiceImplementationRegistry().FindFactory('ICalcService'));
RegisterVerbHandler('Add',{$IFDEF FPC}@{$ENDIF}AddHandler);
RegisterVerbHandler('Substract',{$IFDEF FPC}@{$ENDIF}SubstractHandler);
end;
{ TCalcService_ServiceBinderFactory }
function TCalcService_ServiceBinderFactory.CreateInstance():IInterface;
begin
Result := FInstance;
end;
constructor TCalcService_ServiceBinderFactory.Create();
begin
FInstance := TCalcService_ServiceBinder.Create() as IInterface;
end;
destructor TCalcService_ServiceBinderFactory.Destroy();
begin
FInstance := nil;
inherited Destroy();
end;
procedure Server_service_RegisterCalcServiceService();
Begin
GetServerServiceRegistry().Register('ICalcService',TCalcService_ServiceBinderFactory.Create() as IItemFactory);
End;
initialization
{$i calcservice.wst}
{$IF DECLARED(Register_calcservice_ServiceMetadata)}
Register_calcservice_ServiceMetadata();
{$IFEND}
End.

108
wst/trunk/samples/soap_headers/server/calcservice_imp.pas Normal file
View File

@ -0,0 +1,108 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice_imp".
Date : "17/08/2008 20:55:09".
}
Unit calcservice_imp;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes,
base_service_intf, server_service_intf, server_service_imputils, calcservice;
Type
{ TCalcService_ServiceImp }
TCalcService_ServiceImp=class(TBaseServiceImplementation,ICalcService)
private
procedure CheckSession();
Protected
function Add(
const A : integer;
const B : integer
):integer;
function Substract(
const A : integer;
const B : integer
):integer;
End;
procedure RegisterCalcServiceImplementationFactory();
Implementation
uses config_objects;
procedure TCalcService_ServiceImp.CheckSession();
var
cc : ICallContext;
hc, i : PtrInt;
h : THeaderBlock;
lh : TLoginHeader;
sh : TSessionHeader;
ok : Boolean;
begin
cc := GetCallContext();
hc := cc.GetHeaderCount([hdOut,hdIn]);
if ( hc < 1 ) then
raise Exception.Create('No login or session header found.');
ok := False;
for i := 0 to Pred(hc) do begin
h := cc.GetHeader(i);
if h.InheritsFrom(TSessionHeader) or h.InheritsFrom(TLoginHeader) then begin
ok := True;
Break;
end;
end;
if not ok then
raise Exception.Create('No login or session header found.');
if h.InheritsFrom(TSessionHeader) then begin
if IsStrEmpty(TSessionHeader(h).SessionToken) then
raise Exception.Create('Invalid session token.');
end else begin
lh := TLoginHeader(h);
if IsStrEmpty(lh.UserName) or IsStrEmpty(lh.Password) then
raise Exception.Create('Invalid login information.');
sh := TSessionHeader.Create();
try
sh.SessionToken := Format('TokenOf_%s_and_%s',[lh.UserName,lh.Password]);
sh.Direction := hdOut;
cc.AddHeader(sh,True);
except
sh.Free();
raise;
end;
lh.Understood := True;
end;
end;
{ TCalcService_ServiceImp implementation }
function TCalcService_ServiceImp.Add(
const A : integer;
const B : integer
):integer;
Begin
CheckSession();
Result := A + B;
End;
function TCalcService_ServiceImp.Substract(
const A : integer;
const B : integer
):integer;
Begin
CheckSession();
Result := A - B;
End;
procedure RegisterCalcServiceImplementationFactory();
Begin
GetServiceImplementationRegistry().Register('ICalcService',TImplementationFactory.Create(TCalcService_ServiceImp,wst_GetServiceConfigText('ICalcService')) as IServiceImplementationFactory);
End;
End.

107
wst/trunk/samples/soap_headers/server/calcservice_proxy.pas Normal file
View File

@ -0,0 +1,107 @@
{
This unit has been produced by ws_helper.
Input unit name : "calcservice".
This unit name : "calcservice_proxy".
Date : "17/08/2008 20:55:09".
}
Unit calcservice_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, calcservice;
Type
TCalcService_Proxy=class(TBaseProxy,ICalcService)
Protected
class function GetServiceType() : PTypeInfo;override;
function Add(
const A : integer;
const B : integer
):integer;
function Substract(
const A : integer;
const B : integer
):integer;
End;
Function wst_CreateInstance_ICalcService(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'):ICalcService;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_ICalcService(const AFormat : string; const ATransport : string):ICalcService;
Begin
Result := TCalcService_Proxy.Create('ICalcService',AFormat+GetServiceDefaultFormatProperties(TypeInfo(ICalcService)),ATransport + 'address=' + GetServiceDefaultAddress(TypeInfo(ICalcService)));
End;
{ TCalcService_Proxy implementation }
class function TCalcService_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(ICalcService);
end;
function TCalcService_Proxy.Add(
const A : integer;
const B : integer
):integer;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('A', TypeInfo(integer), A);
locSerializer.Put('B', TypeInfo(integer), B);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(integer), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TCalcService_Proxy.Substract(
const A : integer;
const B : integer
):integer;
Var
locSerializer : IFormatterClient;
strPrmName : string;
Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Substract', GetTarget(),(Self as ICallContext));
locSerializer.Put('A', TypeInfo(integer), A);
locSerializer.Put('B', TypeInfo(integer), B);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead((Self as ICallContext));
strPrmName := 'result';
locSerializer.Get(TypeInfo(integer), strPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i calcservice.wst}
{$IF DECLARED(Register_calcservice_ServiceMetadata)}
Register_calcservice_ServiceMetadata();
{$IFEND}
End.

93
wst/trunk/samples/soap_headers/server/srv_calc.lpi Normal file
View File

@ -0,0 +1,93 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<Title Value="Web Service Toolkit - &quot;CalcService&quot; Server sample"/>
</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="5">
<Unit0>
<Filename Value="srv_calc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="srv_calc"/>
</Unit0>
<Unit1>
<Filename Value="calcservice_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice_proxy"/>
</Unit1>
<Unit2>
<Filename Value="calcservice.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice"/>
</Unit2>
<Unit3>
<Filename Value="calcservice_binder.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice_binder"/>
</Unit3>
<Unit4>
<Filename Value="calcservice_imp.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calcservice_imp"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="srv_calc"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\..\"/>
<OtherUnitFiles Value="..\..\..\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-dINDY_10
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

36
wst/trunk/samples/soap_headers/server/srv_calc.pas Normal file
View File

@ -0,0 +1,36 @@
{$UNDEF LOG_TO_FILE}
program srv_calc;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}cthreads,{$ENDIF}
Classes, SysUtils,
server_listener, indy_http_server,
server_service_intf, server_service_soap, metadata_service,
calcservice, calcservice_binder, calcservice_imp
{$IFDEF LOG_TO_FILE}
,file_logger_extension
{$ENDIF LOG_TO_FILE}
;
var
AppObject : TwstListener;
begin
Server_service_RegisterSoapFormat();
RegisterCalcServiceImplementationFactory();
Server_service_RegisterCalcServiceService();
{$IFDEF LOG_TO_FILE}
LogFileCompleteName := Format('.%slog.txt',[PathDelim]);
GetServiceImplementationRegistry().FindFactory('ICalcService').RegisterExtension(['TFileLoggerServiceExtension']);
{$ENDIF LOG_TO_FILE}
AppObject := TwstIndyHttpListener.Create('127.0.0.1',8000);
try
WriteLn('"Web Service Toolkit" HTTP Server listening at:');
WriteLn('');
WriteLn('http://127.0.0.1:8000/');
WriteLn('');
WriteLn('Press enter to quit.');
AppObject.Start();
ReadLn();
finally
FreeAndNil(AppObject);
end;
end.