delphi xe2实现.net中的wcf并支持回调

Posted 2023-02-16

技术标签:

【中文标题】delphi xe2实现.net中的wcf并支持回调【英文标题】：delphi xe2 implementing wcf made in .net and support callback 【发布时间】：2012-06-15 20:28:03 【问题描述】：

我制作了一个简单的 .NET WCF wsDualHttpBinding 来回调客户端。现在我正在尝试制作一个简单的 delphi 控制台应用程序来实现我的 wcf 服务。这是 wsdl soap 1.2 在 delphi 中为我生成的代码

我认为我需要做的是这样的事情，但无法理解 Delphi 对 OnMessageAdded 的期望

Listener := MessageService.GetIMessage(true);
Listener.Subscribe(MessageService.Subscribe.Create);

Listener.OnMessageAdded :=
Sender := MessageService.GetIMessage(true);
Sender.Subscribe(MessageService.Subscribe.Create);

这是 WSDL http://pastebin.com/H4mJmjS4

这里是delphi xe2生成的代码

// ************************************************************************ //
// The types declared in this file were generated from data read from the
// WSDL File described below:
// WSDL     : http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/?wsdl
//  >Import : http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/?wsdl>0
//  >Import : http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/?xsd=xsd0
//  >Import : http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/?xsd=xsd1
// Encoding : utf-8
// Codegen  : [wfForceSOAP12+]
// Version  : 1.0
// (06/15/2012 2:43:02 PM - - $Rev: 45757 $)
// ************************************************************************ //

unit MessageService;

interface

uses InvokeRegistry, SOAPHTTPClient, Types, XSBuiltIns;

const
  IS_OPTN = $0001;
  IS_NLBL = $0004;
  IS_REF  = $0080;


type

  // ************************************************************************ //
  // The following types, referred to in the WSDL document are not being represented
  // in this file. They are either aliases[@] of other types represented or were referred
  // to but never[!] declared in the document. The types from the latter category
  // typically map to predefined/known XML or Embarcadero types; however, they could also
  // indicate incorrect WSDL documents that failed to declare or import a schema type.
  // ************************************************************************ //
  // !:string          - "http://www.w3.org/2001/XMLSchema"[Gbl]
  // !:dateTime        - "http://www.w3.org/2001/XMLSchema"[Gbl]
  // !:boolean         - "http://www.w3.org/2001/XMLSchema"[Gbl]

  Subscribe            = class;                  "http://tempuri.org/"[Lit][GblElm] 
  AddMessageResponse   = class;                  "http://tempuri.org/"[Lit][GblElm] 
  AddMessage           = class;                  "http://tempuri.org/"[Lit][GblElm] 
  OnMessageAdded       = class;                  "http://tempuri.org/"[Lit][GblElm] 
  UnsubscribeResponse  = class;                  "http://tempuri.org/"[Lit][GblElm] 
  SubscribeResponse    = class;                  "http://tempuri.org/"[Lit][GblElm] 
  Unsubscribe          = class;                  "http://tempuri.org/"[Lit][GblElm] 



  // ************************************************************************ //
  // XML       : Subscribe, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  Subscribe = class(TRemotable)
  private
  public
    constructor Create; override;
  published
  end;



  // ************************************************************************ //
  // XML       : AddMessageResponse, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  AddMessageResponse = class(TRemotable)
  private
  public
    constructor Create; override;
  published
  end;



  // ************************************************************************ //
  // XML       : AddMessage, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  AddMessage = class(TRemotable)
  private
    Fmessage_: string;
    Fmessage__Specified: boolean;
    procedure Setmessage_(Index: Integer; const Astring: string);
    function  message__Specified(Index: Integer): boolean;
  public
    constructor Create; override;
  published
    property message_: string  Index (IS_OPTN or IS_NLBL) read Fmessage_ write Setmessage_ stored message__Specified;
  end;



  // ************************************************************************ //
  // XML       : OnMessageAdded, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  OnMessageAdded = class(TRemotable)
  private
    Fmessage_: string;
    Fmessage__Specified: boolean;
    Ftimestamp: TXSDateTime;
    Ftimestamp_Specified: boolean;
    procedure Setmessage_(Index: Integer; const Astring: string);
    function  message__Specified(Index: Integer): boolean;
    procedure Settimestamp(Index: Integer; const ATXSDateTime: TXSDateTime);
    function  timestamp_Specified(Index: Integer): boolean;
  public
    constructor Create; override;
    destructor Destroy; override;
  published
    property message_:  string       Index (IS_OPTN or IS_NLBL) read Fmessage_ write Setmessage_ stored message__Specified;
    property timestamp: TXSDateTime  Index (IS_OPTN) read Ftimestamp write Settimestamp stored timestamp_Specified;
  end;



  // ************************************************************************ //
  // XML       : UnsubscribeResponse, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  UnsubscribeResponse = class(TRemotable)
  private
    FUnsubscribeResult: Boolean;
    FUnsubscribeResult_Specified: boolean;
    procedure SetUnsubscribeResult(Index: Integer; const ABoolean: Boolean);
    function  UnsubscribeResult_Specified(Index: Integer): boolean;
  public
    constructor Create; override;
  published
    property UnsubscribeResult: Boolean  Index (IS_OPTN) read FUnsubscribeResult write SetUnsubscribeResult stored UnsubscribeResult_Specified;
  end;



  // ************************************************************************ //
  // XML       : SubscribeResponse, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  SubscribeResponse = class(TRemotable)
  private
    FSubscribeResult: Boolean;
    FSubscribeResult_Specified: boolean;
    procedure SetSubscribeResult(Index: Integer; const ABoolean: Boolean);
    function  SubscribeResult_Specified(Index: Integer): boolean;
  public
    constructor Create; override;
  published
    property SubscribeResult: Boolean  Index (IS_OPTN) read FSubscribeResult write SetSubscribeResult stored SubscribeResult_Specified;
  end;



  // ************************************************************************ //
  // XML       : Unsubscribe, global, <element>
  // Namespace : http://tempuri.org/
  // Serializtn: [xoLiteralParam]
  // Info      : Wrapper
  // ************************************************************************ //
  Unsubscribe = class(TRemotable)
  private
  public
    constructor Create; override;
  published
  end;


  // ************************************************************************ //
  // Namespace : http://tempuri.org/
  // soapAction: http://tempuri.org/IMessage/%operationName%
  // transport : http://schemas.xmlsoap.org/soap/http
  // style     : document
  // use       : literal
  // binding   : WSDualHttpBinding_IMessage
  // service   : MessageService
  // port      : WSDualHttpBinding_IMessage
  // URL       : http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/
  // ************************************************************************ //
  IMessage = interface(IInvokable)
  ['8AE9E38B-51D7-6EB7-5470-5B197F54CF0A']
    function  AddMessage(const parameters: AddMessage): AddMessageResponse; stdcall;
    function  Subscribe(const parameters: Subscribe): SubscribeResponse; stdcall;
    function  Unsubscribe(const parameters: Unsubscribe): UnsubscribeResponse; stdcall;

    // Cannot unwrap:
    //     - More than one strictly out element was found
    function  OnMessageAdded: OnMessageAdded; stdcall;
  end;

function GetIMessage(UseWSDL: Boolean=System.False; Addr: string=''; HTTPRIO: THTTPRIO = nil): IMessage;


implementation
  uses SysUtils;

function GetIMessage(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): IMessage;
const
  defWSDL = 'http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/?wsdl';
  defURL  = 'http://localhost:8700/Design_Time_Addresses/WCFCallbacks/Message/';
  defSvc  = 'MessageService';
  defPrt  = 'WSDualHttpBinding_IMessage';
var
  RIO: THTTPRIO;
begin
  Result := nil;
  if (Addr = '') then
  begin
    if UseWSDL then
      Addr := defWSDL
    else
      Addr := defURL;
  end;
  if HTTPRIO = nil then
    RIO := THTTPRIO.Create(nil)
  else
    RIO := HTTPRIO;
  try
    Result := (RIO as IMessage);
    if UseWSDL then
    begin
      RIO.WSDLLocation := Addr;
      RIO.Service := defSvc;
      RIO.Port := defPrt;
    end else
      RIO.URL := Addr;
  finally
    if (Result = nil) and (HTTPRIO = nil) then
      RIO.Free;
  end;
end;


constructor Subscribe.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

constructor AddMessageResponse.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

constructor AddMessage.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

procedure AddMessage.Setmessage_(Index: Integer; const Astring: string);
begin
  Fmessage_ := Astring;
  Fmessage__Specified := True;
end;

function AddMessage.message__Specified(Index: Integer): boolean;
begin
  Result := Fmessage__Specified;
end;

constructor OnMessageAdded.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

destructor OnMessageAdded.Destroy;
begin
  SysUtils.FreeAndNil(Ftimestamp);
  inherited Destroy;
end;

procedure OnMessageAdded.Setmessage_(Index: Integer; const Astring: string);
begin
  Fmessage_ := Astring;
  Fmessage__Specified := True;
end;

function OnMessageAdded.message__Specified(Index: Integer): boolean;
begin
  Result := Fmessage__Specified;
end;

procedure OnMessageAdded.Settimestamp(Index: Integer; const ATXSDateTime: TXSDateTime);
begin
  Ftimestamp := ATXSDateTime;
  Ftimestamp_Specified := True;
end;

function OnMessageAdded.timestamp_Specified(Index: Integer): boolean;
begin
  Result := Ftimestamp_Specified;
end;

constructor UnsubscribeResponse.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

procedure UnsubscribeResponse.SetUnsubscribeResult(Index: Integer; const ABoolean: Boolean);
begin
  FUnsubscribeResult := ABoolean;
  FUnsubscribeResult_Specified := True;
end;

function UnsubscribeResponse.UnsubscribeResult_Specified(Index: Integer): boolean;
begin
  Result := FUnsubscribeResult_Specified;
end;

constructor SubscribeResponse.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

procedure SubscribeResponse.SetSubscribeResult(Index: Integer; const ABoolean: Boolean);
begin
  FSubscribeResult := ABoolean;
  FSubscribeResult_Specified := True;
end;

function SubscribeResponse.SubscribeResult_Specified(Index: Integer): boolean;
begin
  Result := FSubscribeResult_Specified;
end;

constructor Unsubscribe.Create;
begin
  inherited Create;
  FSerializationOptions := [xoLiteralParam];
end;

initialization
   IMessage 
  InvRegistry.RegisterInterface(TypeInfo(IMessage), 'http://tempuri.org/', 'utf-8');
  InvRegistry.RegisterDefaultSOAPAction(TypeInfo(IMessage), 'http://tempuri.org/IMessage/%operationName%');
  InvRegistry.RegisterInvokeOptions(TypeInfo(IMessage), ioDocument);
  InvRegistry.RegisterInvokeOptions(TypeInfo(IMessage), ioLiteral);
  InvRegistry.RegisterInvokeOptions(TypeInfo(IMessage), iosOAP12);
  RemClassRegistry.RegisterXSClass(Subscribe, 'http://tempuri.org/', 'Subscribe');
  RemClassRegistry.RegisterSerializeOptions(Subscribe, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(AddMessageResponse, 'http://tempuri.org/', 'AddMessageResponse');
  RemClassRegistry.RegisterSerializeOptions(AddMessageResponse, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(AddMessage, 'http://tempuri.org/', 'AddMessage');
  RemClassRegistry.RegisterExternalPropName(TypeInfo(AddMessage), 'message_', '[ExtName="message"]');
  RemClassRegistry.RegisterSerializeOptions(AddMessage, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(OnMessageAdded, 'http://tempuri.org/', 'OnMessageAdded');
  RemClassRegistry.RegisterExternalPropName(TypeInfo(OnMessageAdded), 'message_', '[ExtName="message"]');
  RemClassRegistry.RegisterSerializeOptions(OnMessageAdded, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(UnsubscribeResponse, 'http://tempuri.org/', 'UnsubscribeResponse');
  RemClassRegistry.RegisterSerializeOptions(UnsubscribeResponse, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(SubscribeResponse, 'http://tempuri.org/', 'SubscribeResponse');
  RemClassRegistry.RegisterSerializeOptions(SubscribeResponse, [xoLiteralParam]);
  RemClassRegistry.RegisterXSClass(Unsubscribe, 'http://tempuri.org/', 'Unsubscribe');
  RemClassRegistry.RegisterSerializeOptions(Unsubscribe, [xoLiteralParam]);

end.

【问题讨论】：

【参考方案1】：

使用 wsDualHttpBinding，WCF 端希望将响应作为 HTTP 请求异步发送到客户端。

所以实际上你的 Delphi 应用程序也需要提供一个接受 WCF 请求的 HTTP 服务器。

在 Delphis SOAP 客户端实现中不包含异步操作支持 - 添加一个仅为回调操作提供匹配方法的 Delphi SOAP 服务器将是一种解决方法。

【讨论】：

是否有一些示例如何在 C# WCF 应用程序和 Delphi 之间设置回调？我似乎无法让它工作

以上是关于delphi xe2实现.net中的wcf并支持回调的主要内容，如果未能解决你的问题，请参考以下文章

使用 Delphi XE2 的 AnimateWindow

如何使用Delphi XE2覆盖WSDL中的服务名称？

Delphi XE2：跳到 CHM 中的锚点？

Delphi XE2 中 MessageDlg 问题

如何从 Delphi XE2 加速文字自动化

如何让 FastCodePatch 在 Delphi XE2 Win64 平台上工作？