home *** CD-ROM | disk | FTP | other *** search
- unit PetrVones.Utils.SoapTrace;
-
- // Reference:
- // http://msdn.microsoft.com/library/en-us/cpref/html/frlrfSystemWebServicesProtocolsSoapExtensionClassTopic.asp
-
- // Usage:
- // Add [TraceExtensionAttribute] to each method you'd like to monitor in code generated by WSDL importer
-
- interface
-
- uses
- System.Xml, System.Web.Services, System.Web.Services.Protocols, System.IO;
-
- type
- TSoapMessageEvent = procedure (Sender: TObject; const Xml: string) of object;
-
- TSoapMonitor = class(TObject)
- private
- FOnRequest: TSoapMessageEvent;
- FOnResponse: TSoapMessageEvent;
- protected
- procedure DoRequest(const Xml: string);
- procedure DoResponse(const Xml: string);
- public
- class function FormatXmlData(const Xml: string): string; static;
- property OnRequest: TSoapMessageEvent add FOnRequest remove FOnRequest;
- property OnResponse: TSoapMessageEvent add FOnResponse remove FOnResponse;
- end;
-
- [AttributeUsage(AttributeTargets.Method)]
- TraceExtensionAttribute = class(SoapExtensionAttribute)
- strict private
- FPriority: Integer;
- public
- function get_ExtensionType: System.Type; override;
- function get_Priority: Integer; override;
- procedure set_Priority(value: Integer); override;
- end;
-
- function SoapMonitor: TSoapMonitor;
-
- implementation
-
- var
- Monitor: TSoapMonitor;
-
- type
- TraceExtension = class(SoapExtension)
- strict private
- OldStream, NewStream: Stream;
- class procedure CopyStream(Source, Dest: Stream);
- function SoapContent: string;
- public
- function ChainStream(s: Stream): Stream; override;
- function GetInitializer(serviceType: System.Type): System.Object; override;
- function GetInitializer(methodInfo: LogicalMethodInfo; attribute: SoapExtensionAttribute): System.Object; override;
- procedure Initialize(initializer: System.Object); override;
- procedure ProcessMessage(message: SoapMessage); override;
- end;
-
- function SoapMonitor: TSoapMonitor;
- begin
- if not Assigned(Monitor) then
- Monitor := TSoapMonitor.Create;
- Result := Monitor;
- end;
-
- { TraceExtension }
-
- function TraceExtension.ChainStream(s: Stream): Stream;
- begin
- OldStream := s;
- NewStream := MemoryStream.Create;
- Result := NewStream;
- end;
-
- class procedure TraceExtension.CopyStream(Source, Dest: Stream);
- var
- Reader: TextReader;
- Writer: TextWriter;
- begin
- Reader := StreamReader.Create(Source);
- Writer := StreamWriter.Create(Dest);
- Writer.WriteLine(Reader.ReadToEnd);
- Writer.Flush;
- end;
-
- function TraceExtension.GetInitializer(serviceType: System.Type): System.Object;
- begin
- Result := nil;
- end;
-
- function TraceExtension.GetInitializer(methodInfo: LogicalMethodInfo; attribute: SoapExtensionAttribute): System.Object;
- begin
- Result := nil;
- end;
-
- procedure TraceExtension.Initialize(initializer: System.Object);
- begin
- end;
-
- procedure TraceExtension.ProcessMessage(message: SoapMessage);
- begin
- case message.Stage of
- SoapMessageStage.AfterSerialize:
- begin
- Monitor.DoRequest(SoapContent);
- CopyStream(NewStream, OldStream);
- end;
- SoapMessageStage.BeforeDeserialize:
- begin
- CopyStream(OldStream, NewStream);
- Monitor.DoResponse(SoapContent);
- end;
- end;
- end;
-
- function TraceExtension.SoapContent: string;
- var
- Reader: StreamReader;
- begin
- NewStream.Position := 0;
- Reader := StreamReader.Create(NewStream);
- Result := Reader.ReadToEnd;
- NewStream.Position := 0;
- end;
-
- { TSoapMonitor }
-
- procedure TSoapMonitor.DoRequest(const Xml: string);
- begin
- if Assigned(FOnRequest) then
- FOnRequest(Self, Xml);
- end;
-
- procedure TSoapMonitor.DoResponse(const Xml: string);
- begin
- if Assigned(FOnResponse) then
- FOnResponse(Self, Xml);
- end;
-
- class function TSoapMonitor.FormatXmlData(const Xml: string): string;
- var
- Doc: XmlDocument;
- Sw: StringWriter;
- Xw: XmlTextWriter;
- begin
- Doc := XmlDocument.Create;
- Doc.LoadXml(Xml);
- Sw := StringWriter.Create;
- Xw := XmlTextWriter.Create(sw);
- Xw.Formatting := Formatting.Indented;
- Xw.Indentation := 2;
- Xw.IndentChar := ' ';
- doc.Save(xw);
- Result := sw.ToString;
- Xw.Close;
- Sw.Close;
- end;
-
- { TraceExtensionAttribute }
-
- function TraceExtensionAttribute.get_ExtensionType: System.Type;
- begin
- Result := typeof(TraceExtension);
- end;
-
- function TraceExtensionAttribute.get_Priority: Integer;
- begin
- Result := FPriority;
- end;
-
- procedure TraceExtensionAttribute.set_Priority(value: Integer);
- begin
- FPriority := value;
- end;
-
- end.
-