';
-
- for i := 0 to Pred(r.GetCount()) do
- Result := Result + '| ' +
+ ''+
''+
''+
'';
end;
-procedure TwstWebApplication.ProcessWSDLRequest(
+procedure TwstIndyHttpListener.ProcessWSDLRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
@@ -251,7 +254,7 @@ begin
AResponseInfo.ContentType := 'text/html';
end;
-procedure TwstWebApplication.ProcessServiceRequest(
+procedure TwstIndyHttpListener.ProcessServiceRequest(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
@@ -289,13 +292,13 @@ begin
end;
except
on e : Exception do begin
- Display('ProcessData()>> Exception = '+e.Message);
+ NotifyMessage('ProcessData()>> Exception = '+e.Message);
raise;
end;
end;
end;
-procedure TwstWebApplication.Handler_CommandGet(
+procedure TwstIndyHttpListener.Handler_CommandGet(
{$IFDEF INDY_10}
AContext : TIdContext;
{$ENDIF}
@@ -306,20 +309,26 @@ procedure TwstWebApplication.Handler_CommandGet(
AResponseInfo : TIdHTTPResponseInfo
);
var
- locPath, locPathPart, s : string;
+{$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);
- Display('----------- QUERY ----------------------');
+ 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);
@@ -328,13 +337,14 @@ begin
Display('--------- RESPONSE ------------------------');
Display(s);
end;
+ {$ENDIF}
Exit;
end;
ProcessWSDLRequest({$IFDEF INDY_10}AContext,{$ENDIF}ARequestInfo,AResponseInfo,locPath);
end;
-constructor TwstWebApplication.Create(
+constructor TwstIndyHttpListener.Create(
const AServerIpAddress : string;
const AListningPort : Integer;
const ADefaultClientPort : Integer;
@@ -355,34 +365,35 @@ begin
FHTTPServerObject.DefaultPort := ADefaultClientPort;
FHTTPServerObject.ServerSoftware := AServerSoftware;
- FHTTPServerObject.Active := True;
+ //FHTTPServerObject.Active := True;
FHTTPServerObject.OnCommandGet := {$IFDEF FPC}@{$ENDIF}Handler_CommandGet;
end;
-destructor TwstWebApplication.Destroy();
+destructor TwstIndyHttpListener.Destroy();
begin
+ if ( FHTTPServerObject <> nil ) then
+ Stop();
FreeAndNil(FHTTPServerObject);
inherited Destroy();
end;
-procedure TwstWebApplication.Display(const AMsg: string);
-begin
- //WriteLn(AMsg);
-end;
-
-
-procedure TwstWebApplication.Start();
+procedure TwstIndyHttpListener.Start();
begin
if not FHTTPServerObject.Active then
FHTTPServerObject.Active := True;
end;
-procedure TwstWebApplication.Stop();
+procedure TwstIndyHttpListener.Stop();
begin
if FHTTPServerObject.Active then
FHTTPServerObject.Active := False;
end;
+class function TwstIndyHttpListener.GetDescription: string;
+begin
+ Result := 'Indy HTTP Listener';
+end;
+
initialization
RegisterStdTypes();
Server_service_RegisterBinaryFormat();
diff --git a/wst/trunk/library_protocol.pas b/wst/trunk/library_protocol.pas
index d139b11c7..ce29e82d8 100644
--- a/wst/trunk/library_protocol.pas
+++ b/wst/trunk/library_protocol.pas
@@ -42,6 +42,7 @@ Type
FFileName: string;
FTarget: string;
private
+ FFormat : string;
procedure SetFileName(const AValue: string);
procedure LoadModule();
public
@@ -53,6 +54,7 @@ Type
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+}
@@ -207,6 +209,7 @@ begin
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));
diff --git a/wst/trunk/library_server_intf.pas b/wst/trunk/library_server_intf.pas
index c05cb1218..30affaa63 100644
--- a/wst/trunk/library_server_intf.pas
+++ b/wst/trunk/library_server_intf.pas
@@ -54,7 +54,7 @@ function wstHandleRequest(
end;
Var
- buff, trgt,ctntyp : string;
+ buff, trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
rdr : IDataStoreReader;
inStream, bufStream : TMemoryStream;
@@ -84,6 +84,7 @@ begin
wstCheck(RET_FALSE,'Invalid buffer.');
trgt := rdr.ReadStr();
ctntyp := rdr.ReadStr();
+ frmt := rdr.ReadStr();
buff := rdr.ReadStr();
rdr := nil;
bufStream.Size := 0;
@@ -91,7 +92,7 @@ begin
inStream.Write(buff[1],Length(buff));
SetLength(buff,0);
inStream.Position := 0;
- rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream,'');
+ rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream,frmt);
HandleServiceRequest(rqst);
bs := bufStream.Size;
wstCheck(ARequestBuffer.SetSize(bs));
diff --git a/wst/trunk/same_process_protocol.pas b/wst/trunk/same_process_protocol.pas
index 5b2173a87..f747b975b 100644
--- a/wst/trunk/same_process_protocol.pas
+++ b/wst/trunk/same_process_protocol.pas
@@ -36,6 +36,7 @@ Type
Private
FAdress: string;
FContentType: string;
+ FFormat : string;
FPropMngr : IPropertyManager;
Public
constructor Create();override;
@@ -45,6 +46,7 @@ Type
Published
property ContentType : string Read FContentType Write FContentType;
property Adress : string Read FAdress Write FAdress;
+ property Format : string read FFormat write FFormat;
End;
{$M+}
@@ -78,7 +80,7 @@ Var
i : Int64;
{$ENDIF WST_DBG}
begin
- bffr := TRequestBuffer.Create(Adress,ContentType,ARequest,AResponse);
+ bffr := TRequestBuffer.Create(Adress,ContentType,ARequest,AResponse,Format);
HandleServiceRequest(bffr);
{$IFDEF WST_DBG}
i := AResponse.Position;
diff --git a/wst/trunk/samples/delphi/http_server/http_server.dpr b/wst/trunk/samples/delphi/http_server/http_server.dpr
index 82e75bb4c..cb3e4fd1d 100644
--- a/wst/trunk/samples/delphi/http_server/http_server.dpr
+++ b/wst/trunk/samples/delphi/http_server/http_server.dpr
@@ -5,28 +5,28 @@ program http_server;
uses
SysUtils,
Classes,
-{$IFNDEF FPC}
ActiveX,
-{$ENDIF}
indy_http_server,
metadata_service,
logger_extension,
- wst_delphi_rtti_utils in '..\..\..\wst_delphi_rtti_utils.pas';
+ wst_delphi_rtti_utils in '..\..\..\wst_delphi_rtti_utils.pas',
+ server_listener in '..\..\..\server_listener.pas';
var
- AppObject : TwstWebApplication;
+ AppObject : TwstIndyHttpListener;
begin
{$IFNDEF FPC}
CoInitialize(nil);
try
{$ENDIF}
- AppObject := TwstWebApplication.Create();
+ 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);
diff --git a/wst/trunk/samples/http_server/http_server.lpi b/wst/trunk/samples/http_server/http_server.lpi
index e244de7fd..7f276693f 100644
--- a/wst/trunk/samples/http_server/http_server.lpi
+++ b/wst/trunk/samples/http_server/http_server.lpi
@@ -34,15 +34,15 @@
-
+
-
+
-
+
@@ -50,15 +50,15 @@
-
+
-
-
+
+
@@ -66,8 +66,8 @@
-
-
+
+
@@ -75,8 +75,8 @@
-
-
+
+
@@ -84,8 +84,8 @@
-
-
+
+
@@ -93,8 +93,8 @@
-
-
+
+
@@ -102,8 +102,8 @@
-
-
+
+
@@ -111,8 +111,8 @@
-
-
+
+
@@ -120,8 +120,8 @@
-
-
+
+
@@ -129,8 +129,8 @@
-
-
+
+
@@ -138,8 +138,8 @@
-
-
+
+
@@ -147,8 +147,8 @@
-
-
+
+
@@ -156,8 +156,8 @@
-
-
+
+
@@ -165,34 +165,34 @@
-
+
-
+
-
+
-
+
-
-
+
+
@@ -200,8 +200,8 @@
-
-
+
+
@@ -209,8 +209,8 @@
-
-
+
+
@@ -218,109 +218,109 @@
-
+
-
+
-
+
-
-
+
+
-
+
-
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
+
-
-
+
+
@@ -328,8 +328,8 @@
-
-
+
+
@@ -337,15 +337,15 @@
-
-
+
+
-
+
@@ -353,15 +353,15 @@
-
+
-
-
+
+
@@ -369,8 +369,8 @@
-
-
+
+
@@ -378,7 +378,7 @@
-
+
@@ -388,7 +388,7 @@
-
+
@@ -397,7 +397,7 @@
-
+
@@ -407,43 +407,76 @@
-
+
-
-
+
+
-
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -466,8 +499,15 @@
+
+
+
+
+
+
-
+
diff --git a/wst/trunk/samples/http_server/http_server.pas b/wst/trunk/samples/http_server/http_server.pas
index 6cc978205..f7ce9ccbb 100644
--- a/wst/trunk/samples/http_server/http_server.pas
+++ b/wst/trunk/samples/http_server/http_server.pas
@@ -7,19 +7,20 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils,
- indy_http_server, metadata_service, logger_extension;
+ indy_http_server, metadata_service, logger_extension, server_listener;
var
- AppObject : TwstWebApplication;
+ AppObject : TwstListener;
begin
- AppObject := TwstWebApplication.Create();
+ 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);
diff --git a/wst/trunk/samples/library_server/lib_server.lpi b/wst/trunk/samples/library_server/lib_server.lpi
index 29b02a523..bac8f514a 100644
--- a/wst/trunk/samples/library_server/lib_server.lpi
+++ b/wst/trunk/samples/library_server/lib_server.lpi
@@ -7,7 +7,7 @@
-
+
@@ -25,24 +25,24 @@
-
+
-
-
+
+
-
+
-
-
+
+
-
+
@@ -50,8 +50,8 @@
-
-
+
+
@@ -59,17 +59,17 @@
-
-
+
+
-
-
+
+
-
+
@@ -77,8 +77,8 @@
-
-
+
+
@@ -86,29 +86,21 @@
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
@@ -117,6 +109,7 @@
+
@@ -124,6 +117,10 @@
+
+
+
+
diff --git a/wst/trunk/samples/library_server/lib_server.lpr b/wst/trunk/samples/library_server/lib_server.lpr
index dcf34b31a..fe65f670c 100644
--- a/wst/trunk/samples/library_server/lib_server.lpr
+++ b/wst/trunk/samples/library_server/lib_server.lpr
@@ -19,7 +19,7 @@ uses
base_service_intf,
server_service_intf,
- server_service_soap, server_binary_formatter,
+ 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,
@@ -35,10 +35,12 @@ begin
RegisterStdTypes();
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
+ Server_service_RegisterXmlRpcFormat();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
- Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
+ Server_service_RegisterWSTMetadataServiceService();
+
end.
diff --git a/wst/trunk/samples/tcp_server/tcp_server.lpi b/wst/trunk/samples/tcp_server/tcp_server.lpi
index 14ad22edf..db2700907 100644
--- a/wst/trunk/samples/tcp_server/tcp_server.lpi
+++ b/wst/trunk/samples/tcp_server/tcp_server.lpi
@@ -12,7 +12,7 @@
-
+
@@ -30,15 +30,15 @@
-
+
-
-
+
+
-
+
@@ -80,7 +80,7 @@
-
+
@@ -117,8 +117,8 @@
-
-
+
+
@@ -127,7 +127,7 @@
-
+
@@ -138,8 +138,8 @@
-
-
+
+
@@ -154,8 +154,8 @@
-
-
+
+
@@ -218,10 +218,10 @@
-
-
-
-
+
+
+
+
@@ -233,10 +233,10 @@
-
-
-
-
+
+
+
+
@@ -273,7 +273,7 @@
-
+
@@ -297,10 +297,10 @@
-
-
+
+
-
+
@@ -315,7 +315,7 @@
-
+
@@ -335,8 +335,8 @@
-
-
+
+
@@ -346,7 +346,7 @@
-
+
@@ -355,7 +355,7 @@
-
+
@@ -377,127 +377,151 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
@@ -526,7 +550,7 @@
-
+
@@ -551,14 +575,6 @@
-
-
-
-
-
-
-
-
diff --git a/wst/trunk/samples/tcp_server/tcp_server.pas b/wst/trunk/samples/tcp_server/tcp_server.pas
index fe03ffa56..5de307e85 100644
--- a/wst/trunk/samples/tcp_server/tcp_server.pas
+++ b/wst/trunk/samples/tcp_server/tcp_server.pas
@@ -27,19 +27,17 @@ uses
base_service_intf, server_service_soap,
base_binary_formatter, server_binary_formatter,
metadata_service, metadata_service_imp, metadata_service_binder,
- synapse_tcp_server,
+ server_listener ,synapse_tcp_server,
user_service_intf, user_service_intf_binder, user_service_intf_imp , imp_helper,
server_service_xmlrpc;
var
- listnerThread : TServerListnerThread;
+ listener : TwstListener;
begin
- SetLogger(TConsoleLogger.Create());
-
Server_service_RegisterBinaryFormat();
- //Server_service_RegisterSoapFormat();
+ Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterWSTMetadataServiceImplementationFactory();
@@ -49,9 +47,10 @@ begin
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
- Logger().Log('WST sample TCP Server listning on "%s"',[sSERVER_PORT]);
- Logger().Log('Hit to stop.');
- listnerThread := TServerListnerThread.Create();
+ WriteLn(Format('WST sample TCP Server listning on "%d"',[sSERVER_PORT]));
+ WriteLn('Hit to stop.');
+ listener := TwstSynapseTcpListener.Create();
+ listener.Start();
ReadLn;
end.
diff --git a/wst/trunk/samples/user_client_console/user_client_console.lpi b/wst/trunk/samples/user_client_console/user_client_console.lpi
index 351161c15..054823897 100644
--- a/wst/trunk/samples/user_client_console/user_client_console.lpi
+++ b/wst/trunk/samples/user_client_console/user_client_console.lpi
@@ -12,7 +12,7 @@
-
+
@@ -30,120 +30,116 @@
-
+
-
-
+
+
-
+
-
+
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
-
+
+
+
+
@@ -151,129 +147,121 @@
-
+
-
+
-
+
-
+
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
+
+
+
-
+
-
-
-
+
+
-
-
-
-
+
+
-
-
+
-
+
-
+
-
+
-
+
-
-
-
-
-
+
+
+
@@ -281,28 +269,186 @@
-
+
-
-
-
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -311,12 +457,18 @@
-
+
+
+
+
+
+
+
diff --git a/wst/trunk/samples/user_client_console/user_client_console.pas b/wst/trunk/samples/user_client_console/user_client_console.pas
index e44f27f2b..ca6d545a2 100644
--- a/wst/trunk/samples/user_client_console/user_client_console.pas
+++ b/wst/trunk/samples/user_client_console/user_client_console.pas
@@ -3,9 +3,9 @@ program user_client_console;
{$mode objfpc}{$H+}
uses
- Classes, SysUtils, TypInfo,
+ Classes, SysUtils, TypInfo, {$IFDEF WINDOWS}ActiveX,{$ENDIF}
user_service_intf_proxy,
- synapse_tcp_protocol, synapse_http_protocol, library_protocol,
+ 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;
@@ -220,50 +220,59 @@ 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;
+{$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;
- WriteLn();
- Write('Choose a item : ');
end;
+{$IFDEF WINDOWS}
+ finally
+ CoUninitialize();
end;
+{$ENDIF}
end.
diff --git a/wst/trunk/server_listener.pas b/wst/trunk/server_listener.pas
new file mode 100644
index 000000000..100b364ab
--- /dev/null
+++ b/wst/trunk/server_listener.pas
@@ -0,0 +1,55 @@
+{
+ 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 server_listener;
+
+interface
+uses
+ Classes, SysUtils;
+
+{$INCLUDE wst.inc}
+{$INCLUDE wst_delphi.inc}
+
+type
+
+ TListnerNotifyMessage = procedure(Sender : TObject; const AMsg : string) of object;
+
+ TwstListener = class(TObject)
+ private
+ FOnNotifyMessage: TListnerNotifyMessage;
+ public
+ class function GetDescription() : string;virtual;
+ procedure Start();virtual;abstract;
+ procedure Stop();virtual;abstract;
+ procedure NotifyMessage(const AMsg : string);
+ property OnNotifyMessage : TListnerNotifyMessage read FOnNotifyMessage write FOnNotifyMessage;
+ end;
+
+
+implementation
+
+{ TwstListener }
+
+class function TwstListener.GetDescription() : string;
+begin
+ Result := ClassName;
+end;
+
+procedure TwstListener.NotifyMessage(const AMsg: string);
+begin
+ if Assigned(FOnNotifyMessage) then
+ FOnNotifyMessage(Self,AMsg);
+end;
+
+end.
diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas
index aad35b5f2..bb3c7dc5a 100644
--- a/wst/trunk/soap_formatter.pas
+++ b/wst/trunk/soap_formatter.pas
@@ -224,16 +224,22 @@ procedure TSOAPCallMaker.MakeCall(
);
Var
rqt, rsps : TMemoryStream;
+ propMngr : IPropertyManager;
{$IFDEF WST_DBG}
s : string;
{$ENDIF WST_DBG}
begin
Assert(Assigned(ASerializer));
Assert(Assigned(ATransport));
- ATransport.GetPropertyManager().SetProperty(
+ propMngr := ATransport.GetPropertyManager();
+ propMngr.SetProperty(
sCONTENT_TYPE,
ASerializer.GetPropertyManager().GetProperty(sCONTENT_TYPE)
);
+ propMngr.SetProperty(
+ sFORMAT,
+ sPROTOCOL_NAME
+ );
rsps := Nil;
rqt := TMemoryStream.Create();
Try
diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas
index e8cb7c279..49b62ce7d 100644
--- a/wst/trunk/synapse_http_protocol.pas
+++ b/wst/trunk/synapse_http_protocol.pas
@@ -38,6 +38,7 @@ Type
FConnection : THTTPSend;
FAddress : string;
private
+ FFormat : string;
FSoapAction: string;
function GetAddress: string;
function GetContentType: string;
@@ -64,6 +65,7 @@ Type
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+}
diff --git a/wst/trunk/synapse_tcp_protocol.pas b/wst/trunk/synapse_tcp_protocol.pas
index 0a0cffc10..bd7522582 100644
--- a/wst/trunk/synapse_tcp_protocol.pas
+++ b/wst/trunk/synapse_tcp_protocol.pas
@@ -37,6 +37,7 @@ Type
{ TTCPTransport }
TTCPTransport = class(TSimpleFactoryItem,ITransport)
Private
+ FFormat : string;
FPropMngr : IPropertyManager;
FConnection : TTCPBlockSocket;
FContentType : string;
@@ -55,6 +56,7 @@ Type
property Address : string Read FAddress Write FAddress;
property Port : string Read FPort Write FPort;
property DefaultTimeOut : Integer read FDefaultTimeOut write FDefaultTimeOut;
+ property Format : string read FFormat write FFormat;
End;
{$M+}
@@ -99,6 +101,7 @@ begin
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));
diff --git a/wst/trunk/synapse_tcp_server.pas b/wst/trunk/synapse_tcp_server.pas
index d5d9f0970..77b46552e 100644
--- a/wst/trunk/synapse_tcp_server.pas
+++ b/wst/trunk/synapse_tcp_server.pas
@@ -16,22 +16,18 @@ unit synapse_tcp_server;
interface
uses
- Classes, SysUtils, blcksock, synsock;
+ Classes, SysUtils, blcksock, synsock, server_listener;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
- sSERVER_PORT = '1234';
+ sSERVER_PORT = 1234;
type
- ILogger = interface
- ['{CA357B9A-604F-4603-96FA-65D445837E80}']
- procedure Log(const AMsg : string);overload;
- procedure Log(const AMsg : string;const AArgs : array of const);overload;
- end;
-
+ TwstSynapseTcpListener = class;
+
{ TClientHandlerThread }
TClientHandlerThread = class(TThread)
@@ -41,12 +37,13 @@ type
FSocketHandle : TSocket;
FInputStream : TMemoryStream;
FOutputStream : TMemoryStream;
+ FOwner : TwstSynapseTcpListener;
private
procedure ClearBuffers();
function ReadInputBuffer():Integer;
procedure SendOutputBuffer();
public
- constructor Create (ASocketHandle : TSocket);
+ constructor Create (ASocketHandle : TSocket; AOwner : TwstSynapseTcpListener);
destructor Destroy();override;
procedure Execute(); override;
property DefaultTimeOut : Integer read FDefaultTimeOut write FDefaultTimeOut;
@@ -58,51 +55,42 @@ type
private
FDefaultTimeOut: Integer;
FSocketObject : TTCPBlockSocket;
+ FSuspendingCount : Integer;
+ FOwner : TwstSynapseTcpListener;
public
- constructor Create();
+ constructor Create(AOwner : TwstSynapseTcpListener);
destructor Destroy(); override;
procedure Execute(); override;
+ procedure SuspendAsSoonAsPossible();
+ procedure ResumeListening();
property DefaultTimeOut : Integer read FDefaultTimeOut write FDefaultTimeOut;
end;
- { TConsoleLogger }
+ { TwstSynapseTcpListener }
- TConsoleLogger = class(TInterfacedObject,IInterface,ILogger)
- protected
- procedure Log(const AMsg : string);overload;
- procedure Log(const AMsg : string;const AArgs : array of const);overload;
+ TwstSynapseTcpListener = class(TwstListener)
+ private
+ FServerThread : TServerListnerThread;
+ FServerIpAddress : string;
+ FListningPort : Integer;
+ FDefaultClientPort : Integer;
+ FServerSoftware : string;
+ public
+ constructor Create(
+ const AServerIpAddress : string = '127.0.0.1';
+ const AListningPort : Integer = sSERVER_PORT;
+ const ADefaultClientPort : Integer = 25000;
+ const AServerSoftware : string = 'Web Service Toolkit Application'
+ );
+ destructor Destroy();override;
+ procedure Start();override;
+ procedure Stop();override;
end;
- function Logger():ILogger ;
- function SetLogger(ALogger : ILogger):ILogger ;
-
implementation
uses binary_streamer, server_service_intf, server_service_imputils
{$IFNDEF FPC},ActiveX{$ENDIF}, ComObj;
-var FLoggerInst : ILogger = nil;
-function SetLogger(ALogger : ILogger):ILogger ;
-begin
- Result := FLoggerInst;
- FLoggerInst := ALogger;
-end;
-
-function Logger():ILogger ;
-begin
- Result := FLoggerInst;
-end;
-
-{ TConsoleLogger }
-
-procedure TConsoleLogger.Log(const AMsg: string);
-begin
- WriteLn(AMsg);
-end;
-
-procedure TConsoleLogger.Log(const AMsg: string; const AArgs: array of const);
-begin
- WriteLn(Format(AMsg,AArgs));
-end;
{ TClientHandlerThread }
@@ -151,11 +139,15 @@ begin
FSocketObject.SendBuffer(FOutputStream.Memory,FOutputStream.Size);
end;
-constructor TClientHandlerThread.Create(ASocketHandle: TSocket);
+constructor TClientHandlerThread.Create(
+ ASocketHandle : TSocket;
+ AOwner : TwstSynapseTcpListener
+);
begin
FSocketHandle := ASocketHandle;
FreeOnTerminate := True;
FDefaultTimeOut := 90000;
+ FOwner := AOwner;
inherited Create(False);
end;
@@ -179,7 +171,7 @@ procedure TClientHandlerThread.Execute();
var
wrtr : IDataStore;
rdr : IDataStoreReader;
- buff, trgt,ctntyp : string;
+ buff, trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
i : PtrUInt;
begin
@@ -201,12 +193,13 @@ begin
rdr := CreateBinaryReader(FInputStream);
trgt := rdr.ReadStr();
ctntyp := rdr.ReadStr();
- buff := rdr.ReadStr(); WriteLn;WriteLn('ContentType=',ctntyp,', ','Target = ',trgt);WriteLn;WriteLn(buff);
+ frmt := rdr.ReadStr();
+ buff := rdr.ReadStr();
rdr := nil;
FInputStream.Size := 0;
FInputStream.Write(buff[1],Length(buff));
FInputStream.Position := 0;
- rqst := TRequestBuffer.Create(trgt,ctntyp,FInputStream,FOutputStream,GetFormatForContentType(ctntyp));
+ rqst := TRequestBuffer.Create(trgt,ctntyp,FInputStream,FOutputStream,frmt);
HandleServiceRequest(rqst);
i := FOutputStream.Size;
SetLength(buff,i);
@@ -221,7 +214,7 @@ begin
end;
except
on e : Exception do begin
- Logger().Log('Error : ThreadID = %d; Message = %s',[Self.ThreadID,e.Message]);
+ FOwner.NotifyMessage(Format('Error : ThreadID = %d; Message = %s',[Self.ThreadID,e.Message]));
end;
end;
finally
@@ -236,11 +229,12 @@ end;
{ TServerListnerThread }
-constructor TServerListnerThread.Create();
+constructor TServerListnerThread.Create(AOwner : TwstSynapseTcpListener);
begin
FSocketObject := TTCPBlockSocket.Create();
FreeOnTerminate := True;
FDefaultTimeOut := 1000;
+ FOwner := AOwner;
inherited Create(false);
end;
@@ -262,18 +256,21 @@ begin
FSocketObject.RaiseExcept := True;
FSocketObject.CreateSocket();
FSocketObject.SetLinger(True,10);
- FSocketObject.Bind('127.0.0.1',sSERVER_PORT);
+ FSocketObject.Bind(FOwner.FServerIpAddress,IntToStr(FOwner.FListningPort));
FSocketObject.Listen();
while not Terminated do begin
+ if ( FSuspendingCount > 0 ) then begin
+ Suspend();
+ end;
if FSocketObject.CanRead(DefaultTimeOut) then begin
ClientSock := FSocketObject.Accept();
- TClientHandlerThread.Create(ClientSock);
+ TClientHandlerThread.Create(ClientSock,FOwner);
end;
end;
except
on e : Exception do begin
- Logger().Log('Listner Thread Error : ThreadID = %d; Message = %s',[Self.ThreadID,e.Message]);
- Logger().Log('Listner stoped.');
+ FOwner.NotifyMessage(Format('Listner Thread Error : ThreadID = %d; Message = %s',[Self.ThreadID,e.Message]));
+ FOwner.NotifyMessage('Listner stoped.');
end;
end;
{$IFNDEF FPC}
@@ -283,5 +280,57 @@ begin
{$ENDIF}
end;
+procedure TServerListnerThread.SuspendAsSoonAsPossible();
+begin
+ InterLockedIncrement(FSuspendingCount);
+end;
+
+procedure TServerListnerThread.ResumeListening();
+begin
+ InterLockedDecrement(FSuspendingCount);
+ if ( FSuspendingCount <= 0 ) then begin
+ if Suspended then
+ Resume();
+ end;
+end;
+
+{ TwstSynapseTcpListener }
+
+constructor TwstSynapseTcpListener.Create(
+ const AServerIpAddress : string;
+ const AListningPort : Integer;
+ const ADefaultClientPort : Integer;
+ const AServerSoftware : string
+);
+begin
+ FServerIpAddress := AServerIpAddress;
+ FListningPort := AListningPort;
+ FDefaultClientPort := ADefaultClientPort;
+ FServerSoftware := AServerSoftware;
+end;
+
+destructor TwstSynapseTcpListener.Destroy();
+begin
+ if ( FServerThread <> nil ) then begin
+ FServerThread.Terminate();
+ Start();
+ end;
+ inherited Destroy();
+end;
+
+procedure TwstSynapseTcpListener.Start();
+begin
+ if ( FServerThread = nil ) then
+ FServerThread := TServerListnerThread.Create(Self);
+ if FServerThread.Suspended then
+ FServerThread.ResumeListening();
+end;
+
+procedure TwstSynapseTcpListener.Stop();
+begin
+ if ( FServerThread <> nil ) and ( not FServerThread.Suspended ) then
+ FServerThread.SuspendAsSoonAsPossible();
+end;
+
end.
diff --git a/wst/trunk/type_lib_edtr/edit_helper.pas b/wst/trunk/type_lib_edtr/edit_helper.pas
index 3d2232a8a..936a6973a 100644
--- a/wst/trunk/type_lib_edtr/edit_helper.pas
+++ b/wst/trunk/type_lib_edtr/edit_helper.pas
@@ -42,6 +42,7 @@ type
function CreateEnum(AContainer : TwstPasTreeContainer) : TPasEnumType;
function CreateCompoundObject(ASymbolTable : TwstPasTreeContainer) : TPasClassType;
+ function CreateArray(ASymbolTable : TwstPasTreeContainer) : TPasArrayType;
function CreateInterface(ASymbolTable : TwstPasTreeContainer) : TPasClassType;
function CreateMethod(
AOwner : TPasClassType;
@@ -73,7 +74,7 @@ type
implementation
uses Contnrs, Forms, ufEnumedit, ufclassedit, uinterfaceedit, uprocedit,
- uargedit, umoduleedit, ubindingedit;
+ uargedit, umoduleedit, ubindingedit, ufarrayedit;
type
@@ -162,6 +163,17 @@ type
):Boolean;override;
end;
+ { TArrayUpdater }
+
+ TArrayUpdater = class(TObjectUpdater)
+ public
+ class function CanHandle(AObject : TObject):Boolean;override;
+ class function UpdateObject(
+ AObject : TPasElement;
+ ASymbolTable : TwstPasTreeContainer
+ ):Boolean;override;
+ end;
+
{ TInterfaceUpdater }
TInterfaceUpdater = class(TObjectUpdater)
@@ -217,6 +229,30 @@ type
):Boolean;override;
end;
+{ TArrayUpdater }
+
+class function TArrayUpdater.CanHandle(AObject : TObject) : Boolean;
+begin
+ Result := ( inherited CanHandle(AObject) ) and AObject.InheritsFrom(TPasArrayType);
+end;
+
+class function TArrayUpdater.UpdateObject(
+ AObject : TPasElement;
+ ASymbolTable : TwstPasTreeContainer
+): Boolean;
+var
+ f : TfArrayEdit;
+ e : TPasArrayType;
+begin
+ e := AObject as TPasArrayType;
+ f := TfArrayEdit.Create(Application);
+ try
+ Result := f.UpdateObject(e,etUpdate,ASymbolTable);
+ finally
+ f.Release();
+ end;
+end;
+
{ TBindingUpdater }
class function TBindingUpdater.CanHandle(AObject: TObject): Boolean;
@@ -458,6 +494,19 @@ begin
end;
end;
+function CreateArray(ASymbolTable : TwstPasTreeContainer) : TPasArrayType;
+var
+ f : TfArrayEdit;
+begin
+ Result := nil;
+ f := TfArrayEdit.Create(Application);
+ try
+ f.UpdateObject(Result,etCreate,ASymbolTable);
+ finally
+ f.Release();
+ end;
+end;
+
function CreateMethod(
AOwner : TPasClassType;
ASymbolTable : TwstPasTreeContainer
@@ -616,6 +665,7 @@ initialization
UpdaterRegistryInst.RegisterHandler(TArgumentUpdater);
UpdaterRegistryInst.RegisterHandler(TModuleUpdater);
UpdaterRegistryInst.RegisterHandler(TBindingUpdater);
+ UpdaterRegistryInst.RegisterHandler(TArrayUpdater);
finalization
FreeAndNil(UpdaterRegistryInst);
diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi
index 1536f2933..cf9d07f7a 100644
--- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi
+++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi
@@ -7,7 +7,7 @@
-
+
@@ -32,13 +32,15 @@
-
+
-
+
-
+
+
+
@@ -47,10 +49,10 @@
-
-
+
+
-
+
@@ -65,8 +67,8 @@
-
-
+
+
@@ -78,8 +80,8 @@
-
-
+
+
@@ -94,7 +96,7 @@
-
+
@@ -103,20 +105,20 @@
-
+
-
-
+
+
-
-
-
-
+
+
+
+
@@ -125,16 +127,16 @@
-
+
-
-
+
+
-
+
@@ -144,10 +146,10 @@
-
-
-
-
+
+
+
+
@@ -156,9 +158,11 @@
-
-
-
+
+
+
+
+
@@ -170,10 +174,10 @@
-
-
-
-
+
+
+
+
@@ -259,7 +263,7 @@
-
+
@@ -276,7 +280,7 @@
-
+
@@ -288,10 +292,10 @@
-
-
-
-
+
+
+
+
@@ -300,7 +304,7 @@
-
+
@@ -315,7 +319,7 @@
-
+
@@ -340,17 +344,15 @@
-
-
-
+
-
-
+
+
@@ -358,9 +360,7 @@
-
-
-
+
@@ -442,7 +442,7 @@
-
+
@@ -457,7 +457,7 @@
-
+
@@ -474,7 +474,7 @@
-
+
@@ -498,7 +498,7 @@
-
+
@@ -515,7 +515,7 @@
-
+
@@ -556,7 +556,7 @@
-
+
@@ -577,8 +577,8 @@
-
-
+
+
@@ -593,11 +593,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr
index 50ba35015..17045b4d0 100644
--- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr
+++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr
@@ -11,11 +11,11 @@ uses
, uwsttypelibraryedit, view_helper, source_utils, uabout, ufEnumedit,
edit_helper, ufclassedit, wsdl_generator, ufpropedit, uinterfaceedit, udm,
pascal_parser_intf, PasTree, PParser, uprocedit, common_gui_utils, uargedit,
- umoduleedit, ubindingedit, ufrmsaveoption;
+ umoduleedit, ubindingedit, ufrmsaveoption, ufarrayedit;
begin
Application.Initialize;
- Application.CreateForm (TfWstTypeLibraryEdit, fWstTypeLibraryEdit );
+ Application.CreateForm(TfWstTypeLibraryEdit, fWstTypeLibraryEdit);
Application.Run;
end.
diff --git a/wst/trunk/type_lib_edtr/ufpropedit.lfm b/wst/trunk/type_lib_edtr/ufpropedit.lfm
index 1a317b5f7..bc45b4d53 100644
--- a/wst/trunk/type_lib_edtr/ufpropedit.lfm
+++ b/wst/trunk/type_lib_edtr/ufpropedit.lfm
@@ -1,7 +1,7 @@
object fPropEdit: TfPropEdit
- Left = 306
+ Left = 862
Height = 326
- Top = 266
+ Top = 68
Width = 324
HorzScrollBar.Page = 323
VertScrollBar.Page = 325
@@ -101,7 +101,7 @@ object fPropEdit: TfPropEdit
Left = 20
Height = 13
Top = 218
- Width = 100
+ Width = 105
Caption = 'Optional property'
Font.Style = [fsItalic]
TabOrder = 3
diff --git a/wst/trunk/type_lib_edtr/ufpropedit.lrs b/wst/trunk/type_lib_edtr/ufpropedit.lrs
index 9fcef8e61..85f52085c 100644
--- a/wst/trunk/type_lib_edtr/ufpropedit.lrs
+++ b/wst/trunk/type_lib_edtr/ufpropedit.lrs
@@ -1,35 +1,35 @@
{ Ceci est un fichier ressource généré automatiquement par Lazarus }
LazarusResources.Add('TfPropEdit','FORMDATA',[
- 'TPF0'#10'TfPropEdit'#9'fPropEdit'#4'Left'#3'2'#1#6'Height'#3'F'#1#3'Top'#3#10
- +#1#5'Width'#3'D'#1#18'HorzScrollBar.Page'#3'C'#1#18'VertScrollBar.Page'#3'E'
- +#1#13'ActiveControl'#7#7'Button1'#11'BorderIcons'#11#12'biSystemMenu'#0#11'B'
- +'orderStyle'#7#8'bsDialog'#7'Caption'#6#9'fPropEdit'#12'ClientHeight'#3'F'#1
- +#11'ClientWidth'#3'D'#1#8'Position'#7#15'poDesktopCenter'#0#6'TPanel'#6'Pane'
- +'l1'#6'Height'#2'2'#3'Top'#3#20#1#5'Width'#3'D'#1#5'Align'#7#8'alBottom'#12
- +'ClientHeight'#2'2'#11'ClientWidth'#3'D'#1#8'TabOrder'#2#0#0#7'TButton'#7'Bu'
- +'tton1'#4'Left'#3#236#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors'
- +#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Ca'
- +'ption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'But'
- +'ton2'#4'Left'#3#146#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5
- +'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4
- +#7'Default'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'PageControl1'#6'Heig'
- +'ht'#3#20#1#5'Width'#3'D'#1#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alCli'
- +'ent'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'
- +#6#8'Property'#12'ClientHeight'#3#250#0#11'ClientWidth'#3'<'#1#0#6'TLabel'#6
- +'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#24#5'Width'#2#28#7'Caption'#6#4
- +'Name'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#20#6'Height'#2#14
- +#3'Top'#2'b'#5'Width'#2#25#7'Caption'#6#4'Type'#11'ParentColor'#8#0#0#5'TEdi'
- +'t'#7'edtName'#4'Left'#2#20#6'Height'#2#23#3'Top'#2'*'#5'Width'#3#16#1#8'Tab'
- +'Order'#2#0#0#0#9'TComboBox'#7'edtType'#4'Left'#2#20#6'Height'#2#21#3'Top'#2
- +'t'#5'Width'#3#16#1#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cb'
- +'actSearchAscending'#0#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14'cs'
- +'DropDownList'#8'TabOrder'#2#1#0#0#9'TCheckBox'#12'edtAttribute'#4'Left'#2#20
- +#6'Height'#2#13#3'Top'#3#170#0#5'Width'#2'e'#7'Caption'#6#18'Attribute Prope'
- +'rty'#8'TabOrder'#2#2#0#0#9'TCheckBox'#11'edtOptional'#4'Left'#2#20#6'Height'
- +#2#13#3'Top'#3#218#0#5'Width'#2'd'#7'Caption'#6#17'Optional property'#10'Fon'
- +'t.Style'#11#8'fsItalic'#0#8'TabOrder'#2#3#0#0#0#0#11'TActionList'#11'Action'
- +'List1'#4'left'#2'h'#3'top'#2'h'#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18
- +'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actO'
- +'KUpdate'#0#0#0#0
+ 'TPF0'#10'TfPropEdit'#9'fPropEdit'#4'Left'#3'^'#3#6'Height'#3'F'#1#3'Top'#2'D'
+ +#5'Width'#3'D'#1#18'HorzScrollBar.Page'#3'C'#1#18'VertScrollBar.Page'#3'E'#1
+ +#13'ActiveControl'#7#7'Button1'#11'BorderIcons'#11#12'biSystemMenu'#0#11'Bor'
+ +'derStyle'#7#8'bsDialog'#7'Caption'#6#9'fPropEdit'#12'ClientHeight'#3'F'#1#11
+ +'ClientWidth'#3'D'#1#8'Position'#7#15'poDesktopCenter'#0#6'TPanel'#6'Panel1'
+ +#6'Height'#2'2'#3'Top'#3#20#1#5'Width'#3'D'#1#5'Align'#7#8'alBottom'#12'Clie'
+ +'ntHeight'#2'2'#11'ClientWidth'#3'D'#1#8'TabOrder'#2#0#0#7'TButton'#7'Button'
+ +'1'#4'Left'#3#236#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5
+ +'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'
+ +#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4
+ +'Left'#3#146#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'
+ +#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Def'
+ +'ault'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'PageControl1'#6'Height'#3
+ +#20#1#5'Width'#3'D'#1#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8
+ +'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#8'Pr'
+ +'operty'#12'ClientHeight'#3#250#0#11'ClientWidth'#3'<'#1#0#6'TLabel'#6'Label'
+ +'1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#24#5'Width'#2#28#7'Caption'#6#4'Nam'
+ +'e'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#20#6'Height'#2#14#3
+ +'Top'#2'b'#5'Width'#2#25#7'Caption'#6#4'Type'#11'ParentColor'#8#0#0#5'TEdit'
+ +#7'edtName'#4'Left'#2#20#6'Height'#2#23#3'Top'#2'*'#5'Width'#3#16#1#8'TabOrd'
+ +'er'#2#0#0#0#9'TComboBox'#7'edtType'#4'Left'#2#20#6'Height'#2#21#3'Top'#2't'
+ +#5'Width'#3#16#1#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbact'
+ +'SearchAscending'#0#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14'csDro'
+ +'pDownList'#8'TabOrder'#2#1#0#0#9'TCheckBox'#12'edtAttribute'#4'Left'#2#20#6
+ +'Height'#2#13#3'Top'#3#170#0#5'Width'#2'e'#7'Caption'#6#18'Attribute Propert'
+ +'y'#8'TabOrder'#2#2#0#0#9'TCheckBox'#11'edtOptional'#4'Left'#2#20#6'Height'#2
+ +#13#3'Top'#3#218#0#5'Width'#2'i'#7'Caption'#6#17'Optional property'#10'Font.'
+ +'Style'#11#8'fsItalic'#0#8'TabOrder'#2#3#0#0#0#0#11'TActionList'#11'ActionLi'
+ +'st1'#4'left'#2'h'#3'top'#2'h'#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'D'
+ +'isableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOK'
+ +'Update'#0#0#0#0
]);
diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm
index 6c459c89e..caa048b83 100644
--- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm
+++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm
@@ -1888,6 +1888,10 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit
Action = actIntfCreate
OnClick = actIntfCreateExecute
end
+ object MenuItem35: TMenuItem
+ Action = actArrayCreate
+ OnClick = actArrayCreateExecute
+ end
object MenuItem12: TMenuItem
Caption = '-'
end
@@ -1989,6 +1993,11 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit
OnExecute = actDeleteExecute
OnUpdate = actUpdateObjectUpdate
end
+ object actArrayCreate: TAction
+ Caption = 'Create Array'
+ DisableIfNoHandler = True
+ OnExecute = actArrayCreateExecute
+ end
end
object OD: TOpenDialog
Title = 'Ouvrir un fichier existant'
diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs
index d703e4400..19984c194 100644
--- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs
+++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.lrs
@@ -292,41 +292,44 @@ LazarusResources.Add('TfWstTypeLibraryEdit','FORMDATA',[
+'ion'#7#13'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExecute'#0#0#9'TMenuI'
+'tem'#10'MenuItem23'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24'actCo'
+'mpoundCreateExecute'#0#0#9'TMenuItem'#10'MenuItem25'#6'Action'#7#13'actIntf'
- +'Create'#7'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem1'
- +'2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem13'#6'Action'#7#15'actUpda'
- +'teObject'#7'Caption'#6#13'Update Object'#7'OnClick'#7#22'actUpdateObjectExe'
- +'cute'#0#0#9'TMenuItem'#10'MenuItem34'#6'Action'#7#9'actDelete'#7'OnClick'#7
- +#16'actDeleteExecute'#0#0#0#9'TMenuItem'#9'MenuItem6'#6'Action'#7#8'actAbout'
- +#7'Caption'#6#6'&About'#7'OnClick'#7#15'actAboutExecute'#0#0#0#11'TActionLis'
- +'t'#2'AL'#4'left'#3'X'#1#3'top'#2'8'#0#7'TAction'#11'actOpenFile'#7'Caption'
- +#6#9'Open File'#18'DisableIfNoHandler'#9#9'OnExecute'#7#18'actOpenFileExecut'
- +'e'#0#0#7'TAction'#7'actExit'#7'Caption'#6#4'Exit'#18'DisableIfNoHandler'#9#9
- +'OnExecute'#7#14'actExitExecute'#0#0#7'TAction'#9'actExport'#7'Caption'#6#24
- +'Save generated files ...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actExp'
- +'ortExecute'#8'OnUpdate'#7#15'actExportUpdate'#0#0#7'TAction'#8'actAbout'#7
- +'Caption'#6#5'About'#18'DisableIfNoHandler'#9#9'OnExecute'#7#15'actAboutExec'
- +'ute'#0#0#7'TAction'#9'actSaveAs'#7'Caption'#6#11'Save As ...'#18'DisableIfN'
- +'oHandler'#9#9'OnExecute'#7#16'actSaveAsExecute'#8'OnUpdate'#7#15'actExportU'
- +'pdate'#0#0#7'TAction'#13'actEnumCreate'#7'Caption'#6#18'Create Enumeration'
- +#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actEnumCreateExecute'#0#0#7'TAct'
- +'ion'#15'actUpdateObject'#7'Caption'#6#6'Update'#18'DisableIfNoHandler'#9#9
- +'OnExecute'#7#22'actUpdateObjectExecute'#8'OnUpdate'#7#21'actUpdateObjectUpd'
- +'ate'#0#0#7'TAction'#14'actRefreshView'#7'Caption'#6#14'&Refresh Views'#18'D'
- +'isableIfNoHandler'#9#9'OnExecute'#7#21'actRefreshViewExecute'#0#0#7'TAction'
- +#10'actNewFile'#7'Caption'#6#8'New File'#18'DisableIfNoHandler'#9#9'OnExecut'
- +'e'#7#17'actNewFileExecute'#0#0#7'TAction'#17'actCompoundCreate'#7'Caption'#6
- +#20'Create Compound Type'#18'DisableIfNoHandler'#9#9'OnExecute'#7#24'actComp'
- +'oundCreateExecute'#0#0#7'TAction'#13'actIntfCreate'#7'Caption'#6#16'Create '
- +'Interface'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actIntfCreateExecute'
- +#0#0#7'TAction'#13'actFullExpand'#7'Caption'#6#11'Full expand'#18'DisableIfN'
- +'oHandler'#9#9'OnExecute'#7#20'actFullExpandExecute'#0#0#7'TAction'#15'actFu'
- +'llCollapse'#7'Caption'#6#13'Full Collapse'#18'DisableIfNoHandler'#9#9'OnExe'
- ,'cute'#7#22'actFullCollapseExecute'#0#0#7'TAction'#7'actSave'#7'Caption'#6#4
- +'Save'#18'DisableIfNoHandler'#9#9'OnExecute'#7#14'actSaveExecute'#0#0#7'TAct'
- +'ion'#9'actDelete'#7'Caption'#6#6'Delete'#18'DisableIfNoHandler'#9#9'OnExecu'
- +'te'#7#16'actDeleteExecute'#8'OnUpdate'#7#21'actUpdateObjectUpdate'#0#0#0#11
- +'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un fichier existant'#6'Filter'#6'3W'
- +'DSL files(*.WSDL)|*.WSDL|Pascal file (*.pas)|*.pas'#11'FilterIndex'#2#0#10
+ +'Create'#7'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem3'
+ +'5'#6'Action'#7#14'actArrayCreate'#7'OnClick'#7#21'actArrayCreateExecute'#0#0
+ +#9'TMenuItem'#10'MenuItem12'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem1'
+ +'3'#6'Action'#7#15'actUpdateObject'#7'Caption'#6#13'Update Object'#7'OnClick'
+ +#7#22'actUpdateObjectExecute'#0#0#9'TMenuItem'#10'MenuItem34'#6'Action'#7#9
+ +'actDelete'#7'OnClick'#7#16'actDeleteExecute'#0#0#0#9'TMenuItem'#9'MenuItem6'
+ +#6'Action'#7#8'actAbout'#7'Caption'#6#6'&About'#7'OnClick'#7#15'actAboutExec'
+ +'ute'#0#0#0#11'TActionList'#2'AL'#4'left'#3'X'#1#3'top'#2'8'#0#7'TAction'#11
+ +'actOpenFile'#7'Caption'#6#9'Open File'#18'DisableIfNoHandler'#9#9'OnExecute'
+ +#7#18'actOpenFileExecute'#0#0#7'TAction'#7'actExit'#7'Caption'#6#4'Exit'#18
+ +'DisableIfNoHandler'#9#9'OnExecute'#7#14'actExitExecute'#0#0#7'TAction'#9'ac'
+ +'tExport'#7'Caption'#6#24'Save generated files ...'#18'DisableIfNoHandler'#9
+ +#9'OnExecute'#7#16'actExportExecute'#8'OnUpdate'#7#15'actExportUpdate'#0#0#7
+ +'TAction'#8'actAbout'#7'Caption'#6#5'About'#18'DisableIfNoHandler'#9#9'OnExe'
+ +'cute'#7#15'actAboutExecute'#0#0#7'TAction'#9'actSaveAs'#7'Caption'#6#11'Sav'
+ +'e As ...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actSaveAsExecute'#8'On'
+ +'Update'#7#15'actExportUpdate'#0#0#7'TAction'#13'actEnumCreate'#7'Caption'#6
+ +#18'Create Enumeration'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actEnumCr'
+ +'eateExecute'#0#0#7'TAction'#15'actUpdateObject'#7'Caption'#6#6'Update'#18'D'
+ +'isableIfNoHandler'#9#9'OnExecute'#7#22'actUpdateObjectExecute'#8'OnUpdate'#7
+ +#21'actUpdateObjectUpdate'#0#0#7'TAction'#14'actRefreshView'#7'Caption'#6#14
+ +'&Refresh Views'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'actRefreshViewEx'
+ +'ecute'#0#0#7'TAction'#10'actNewFile'#7'Caption'#6#8'New File'#18'DisableIfN'
+ +'oHandler'#9#9'OnExecute'#7#17'actNewFileExecute'#0#0#7'TAction'#17'actCompo'
+ +'undCreate'#7'Caption'#6#20'Create Compound Type'#18'DisableIfNoHandler'#9#9
+ +'OnExecute'#7#24'actCompoundCreateExecute'#0#0#7'TAction'#13'actIntfCreate'#7
+ +'Caption'#6#16'Create Interface'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20
+ +'actIntfCreateExecute'#0#0#7'TAction'#13'actFullExpand'#7'Caption'#6#11'Full'
+ +' expand'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actFullExpandExecute'#0
+ ,#0#7'TAction'#15'actFullCollapse'#7'Caption'#6#13'Full Collapse'#18'DisableI'
+ +'fNoHandler'#9#9'OnExecute'#7#22'actFullCollapseExecute'#0#0#7'TAction'#7'ac'
+ +'tSave'#7'Caption'#6#4'Save'#18'DisableIfNoHandler'#9#9'OnExecute'#7#14'actS'
+ +'aveExecute'#0#0#7'TAction'#9'actDelete'#7'Caption'#6#6'Delete'#18'DisableIf'
+ +'NoHandler'#9#9'OnExecute'#7#16'actDeleteExecute'#8'OnUpdate'#7#21'actUpdate'
+ +'ObjectUpdate'#0#0#7'TAction'#14'actArrayCreate'#7'Caption'#6#12'Create Arra'
+ +'y'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'actArrayCreateExecute'#0#0#0
+ +#11'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un fichier existant'#6'Filter'#6
+ +'3WDSL files(*.WSDL)|*.WSDL|Pascal file (*.pas)|*.pas'#11'FilterIndex'#2#0#10
+'InitialDir'#6#2'.\'#7'Options'#11#15'ofPathMustExist'#15'ofFileMustExist'#14
+'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#153#1#3'top'#2'X'#0#0#10'TSynP'
+'asSyn'#10'SynPasSyn1'#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'
diff --git a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas
index 90ad47648..9bed01f8d 100644
--- a/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas
+++ b/wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas
@@ -38,6 +38,7 @@ type
actFullExpand: TAction;
actFullCollapse: TAction;
actDelete : TAction;
+ actArrayCreate : TAction;
actSave : TAction;
actNewFile: TAction;
actRefreshView: TAction;
@@ -71,6 +72,7 @@ type
MenuItem32: TMenuItem;
MenuItem33 : TMenuItem;
MenuItem34 : TMenuItem;
+ MenuItem35 : TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7 : TMenuItem;
@@ -105,6 +107,7 @@ type
tsProxy: TTabSheet;
trvSchema: TTreeView;
procedure actAboutExecute(Sender: TObject);
+ procedure actArrayCreateExecute(Sender : TObject);
procedure actCompoundCreateExecute(Sender: TObject);
procedure actDeleteExecute (Sender : TObject );
procedure actEnumCreateExecute(Sender: TObject);
@@ -532,6 +535,16 @@ begin
end;
end;
+procedure TfWstTypeLibraryEdit.actArrayCreateExecute(Sender : TObject);
+var
+ e : TPasArrayType;
+begin
+ e := CreateArray(FSymbolTable);
+ if Assigned(e) then begin
+ FindPainter(e).Paint(FSymbolTable,e,GetTypeNode());
+ end;
+end;
+
procedure TfWstTypeLibraryEdit.actCompoundCreateExecute(Sender: TObject);
var
e : TPasClassType;
diff --git a/wst/trunk/type_lib_edtr/view_helper.pas b/wst/trunk/type_lib_edtr/view_helper.pas
index b70267e41..338d64d38 100644
--- a/wst/trunk/type_lib_edtr/view_helper.pas
+++ b/wst/trunk/type_lib_edtr/view_helper.pas
@@ -235,6 +235,13 @@ type
class function CanHandle(AObj : TObject):Boolean;override;
end;
+ { TArrayTypeDefinitionPainter }
+
+ TArrayTypeDefinitionPainter = class(TTypeSymbolPainter)
+ public
+ class function CanHandle(AObj : TObject):Boolean;override;
+ end;
+
{ TMethodDefinitionPainter }
TMethodDefinitionPainter = class(TTypeSymbolPainter)
@@ -287,6 +294,13 @@ type
class function CanHandle(AObj : TObject):Boolean;override;
end;
+{ TArrayTypeDefinitionPainter }
+
+class function TArrayTypeDefinitionPainter.CanHandle(AObj : TObject) : Boolean;
+begin
+ Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasArrayType);
+end;
+
{ TBindingPainter }
function TBindingPainter.Paint(
@@ -541,7 +555,6 @@ begin
Result := ( inherited CanHandle(AObj) ) and
( AObj.InheritsFrom(TPasClassType) and ( TPasClassType(AObj).ObjKind = okClass ) ) and
( not AObj.InheritsFrom(TPasNativeClassType) );
-
end;
{ TEnumTypeDefinitionPainter }
@@ -708,7 +721,8 @@ initialization
FPainterRegistryInst.RegisterHandler(TInterfaceDefinitionPainter);
FPainterRegistryInst.RegisterHandler(TMethodDefinitionPainter);
FPainterRegistryInst.RegisterHandler(TPasNativeSimpleTypePainter);
- FPainterRegistryInst.RegisterHandler(TBindingPainter)
+ FPainterRegistryInst.RegisterHandler(TBindingPainter);
+ FPainterRegistryInst.RegisterHandler(TArrayTypeDefinitionPainter);
finalization
FreeAndNil(FPainterRegistryInst);
diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas
index b1974202d..232b8a9a7 100644
--- a/wst/trunk/ws_helper/pascal_parser_intf.pas
+++ b/wst/trunk/ws_helper/pascal_parser_intf.pas
@@ -109,6 +109,8 @@ type
function GetArrayItemName(AArray : TPasArrayType) : string;
function GetArrayItemExternalName(AArray : TPasArrayType) : string;
function GetArrayStyle(AArray : TPasArrayType) : TArrayStyle;
+ procedure SetArrayStyle(AArray : TPasArrayType; const AStyle : TArrayStyle);
+ procedure SetArrayItemExternalName(AArray : TPasArrayType; const AExternalName : string);
function FindElement(const AName: String): TPasElement; override;
function FindElementInModule(const AName: String; AModule: TPasModule): TPasElement;
function FindModule(const AName: String): TPasModule;override;
@@ -493,6 +495,25 @@ begin
Result := asScoped;
end;
+procedure TwstPasTreeContainer.SetArrayStyle(
+ AArray : TPasArrayType;
+ const AStyle : TArrayStyle
+);
+begin
+ if ( AStyle = asEmbeded ) then
+ Properties.SetValue(AArray,sARRAY_STYLE,sARRAY_STYLE_EMBEDDED)
+ else
+ Properties.SetValue(AArray,sARRAY_STYLE,sARRAY_STYLE_SCOPED);
+end;
+
+procedure TwstPasTreeContainer.SetArrayItemExternalName(
+ AArray : TPasArrayType;
+ const AExternalName : string
+);
+begin
+ Properties.SetValue(AArray,sARRAY_ITEM_EXT_NAME,AExternalName);
+end;
+
function TwstPasTreeContainer.FindElementInModule(const AName: String; AModule : TPasModule): TPasElement;
var
decs : TList;
diff --git a/wst/trunk/xmlrpc_formatter.pas b/wst/trunk/xmlrpc_formatter.pas
index 08d2a3452..9dc6dc3ac 100644
--- a/wst/trunk/xmlrpc_formatter.pas
+++ b/wst/trunk/xmlrpc_formatter.pas
@@ -205,13 +205,19 @@ procedure TXmlRpcCallMaker.MakeCall(
);
var
rqt, rsps : TMemoryStream;
+ propMngr : IPropertyManager;
begin
Assert(Assigned(ASerializer));
Assert(Assigned(ATransport));
- ATransport.GetPropertyManager().SetProperty(
+ propMngr := ATransport.GetPropertyManager();
+ propMngr.SetProperty(
sCONTENT_TYPE,
ASerializer.GetPropertyManager().GetProperty(sCONTENT_TYPE)
);
+ propMngr.SetProperty(
+ sFORMAT,
+ sPROTOCOL_NAME
+ );
rsps := nil;
rqt := TMemoryStream.Create();
try
|