idhttprio.pas

C/S方式下的HTTPS安全数据传输控件.控件在INDY9 和delphi7下编译通过.可以很好的使用

unit IdHTTPRIO;

interface

uses
  SysUtils, Classes, Rio, WSDLNode, WSDLItems, OPConvert, OPToSOAPDomConv,
  IdSOAPHTTPTrans, WebNode, XMLIntf;

type
  TIdHTTPRIO = class(TRIO)
  private
    { Private declarations }
    FWSDLItems: TWSDLItems;
    WSDLItemDoc: IXMLDocument;
    FWSDLView: TWSDLView;
    FWSDLLocation: string;
    FDOMConverter: TOPToSoapDomConvert;
    FHTTPWebNode: TIdHTTPReqResp;
    FDefaultConverter: TOPToSoapDomConvert;
    FDefaultWebNode: TIdHTTPReqResp;
    FBeforeConnect: TNotifyEvent;
    procedure ClearDependentWSDLView;
    procedure SetWSDLLocation(Value: string);
    function GetPort: string;
    procedure SetPortValue(Value: string);
    function GetService: string;
    procedure SetService(Value: string);
    procedure CheckWSDLView;
    procedure SetURL(Value: string);
    function GetDomConverter: TOpToSoapDomConvert;
    procedure SetDomConverter(Value: TOPToSoapDomConvert);
    function GetHTTPWebNode: TIdHTTPReqResp;
    procedure SetHTTPWebNode(Value: TIdHTTPReqResp);
    function GetURL: string;
    function GetDefaultWebNode: TIdHTTPReqResp;
    function GetDefaultConverter: TOPToSoapDomConvert;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    property WSDLItems: TWSDLItems read FWSDLItems;
  published
    { Published declarations }
    property WSDLLocation: string read FWSDLLocation write SetWSDLLocation;
    property Service: string read GetService write SetService;
    property Port: string read GetPort write SetPortValue;
    property URL: string read GetURL write SetURL;
    property HTTPWebNode: TIdHTTPReqResp read GetHTTPWebNode write SetHTTPWebNode;
    property Converter: TOPToSoapDomConvert read GetDomConverter write SetDOMConverter;
    property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
  end;

procedure Register;

implementation

uses InvokeRegistry;

procedure Register;
begin
  RegisterComponents('WebServices', [TIdHTTPRIO]);
end;

constructor TIdHTTPRIO.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Converter }
  FDomConverter := GetDefaultConverter;
  FConverter := FDomConverter as IOPConvert;
  { WebNode }
  FHTTPWebNode := GetDefaultWebNode;
  FWebNode := FHTTPWebNode as IWebNode;
end;

destructor TIdHTTPRIO.Destroy;
begin
  if Assigned(FConverter) then
  FConverter := nil;
  if Assigned(FWebNode) then
    FWebNode := nil;
  if Assigned(FWSDLView) then
    FWSDLView.Free;
  { All components we own are automatically cleaned up }
  inherited;
end;

function TIdHTTPRIO.GetDefaultWebNode: TIdHTTPReqResp;
begin
  if (FDefaultWebNode = nil) then
  begin
    FDefaultWebNode := TIdHTTPReqResp.Create(Self);
    FDefaultWebNode.Name := 'HTTPWebNode1'; { do not localize }
    FDefaultWebNode.SetSubComponent(True);
  end;
  Result := FDefaultWebNode;
end;

function TIdHTTPRIO.GetDefaultConverter: TOPToSoapDomConvert;
begin
  if (FDefaultConverter = nil) then
  begin
    FDefaultConverter := TOPToSoapDomConvert.Create(Self);
    FDefaultConverter.Name := 'Converter1'; { do not localize }
    FDefaultConverter.SetSubComponent(True);
  end;
  Result := FDefaultConverter;
end;

procedure TIdHTTPRIO.ClearDependentWSDLView;
begin
  if Assigned(FDomConverter) and Assigned(FDOMConverter.WSDLView) then
  FDOMConverter.WSDLView := nil;
  if Assigned(FHTTPWebNode) and Assigned(FHTTPWebNode.WSDLView) then
  FHTTPWebNode.WSDLView := FWSDLView;
end;

procedure TIdHTTPRIO.CheckWSDLView;
begin
  if not Assigned(FWSDLItems) then
  begin
    if not Assigned(FWSDLItems) then
    begin
      FWSDLItems := TWSDLItems.Create(nil);
      WSDLItemDoc := FWSDLItems;
    end;
    if not Assigned(FWSDLView) then
    begin
      FWSDLView := TWSDLView.Create(nil);
      FWSDLView.SetDesignState(csDesigning in ComponentState);
    end;
    FWSDLView.WSDL := FWSDLItems;
    if Assigned(FDomConverter) then
      FDOMConverter.WSDLView := FWSDLView;
    if Assigned(FHTTPWebNode) then
        FHTTPWebNode.WSDLView := FWSDLView;
  end;
end;

function TIdHTTPRIO.GetPort: string;
begin
  if Assigned(FWSDLView) then
    Result := FWSDLView.Port
  else
    Result := '';
end;

function TIdHTTPRIO.GetService: string;
begin
  if Assigned(FWSDLView) then
    Result := FWSDLView.Service
  else
    Result := '';
end;

procedure TIdHTTPRIO.SetPortValue(Value: string);
begin
  if Assigned(FWSDLView) then
  FWSDLView.Port := Value;
end;

procedure TIdHTTPRIO.SetService(Value: string);
begin
  if Assigned(FWSDLView) then
    FWSDLView.Service := Value;
end;

procedure TIdHTTPRIO.SetURL(Value: string);
begin
  if Assigned(FHTTPWebNode) then
  begin
    FHTTPWebNode.URL := Value;
    if Value <> '' then
    begin
      WSDLLocation := '';
      ClearDependentWSDLView;
    end;
  end;
end;

procedure TIdHTTPRIO.SetWSDLLocation(Value: string);
begin
{ WSDLLocation and URL are currently mutually exclusive }
{ So clear out URL if we're setting a WSDLLocation }
  if (Value <> '') and (URL <> '') then
    FHTTPWebNode.URL := '';
{ Clear any currently cached WSDLs.
NOTE: A RIO can only be bound to one given interface.
Therefore switching WSDL will be a rather rare
scenario. However, it's possible to have multiple
Services that implement the same portype but
expose different WSDLs. Case in point is the
Interop Service that are exposed by various
SOAP vendors. So to that end, we'll clear
the WSDL Cache }
  if Assigned(FWSDLItems) and (WSDLItemDoc <> nil) then
  begin
    WSDLItemDoc := nil;
    FWSDLItems := nil;
  end;
{ This will recreate the WSDLView/Items }
  CheckWSDLView;
{ Deactivate }
  if FWSDLItems.Active then
    FWSDLItems.Active := False;
  FWSDLLocation := Value;
{ Store the WSDLLocation as the FileName of the TWSDLItems }
  FWSDLItems.FileName := Value;
  FWSDLView.Port := '';
  FWSDLView.Service := '';
end;

function TIdHTTPRIO.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := inherited QueryInterface(IID, Obj);
{ Here we check if we just bounded to an interface - and if yes, we retrieve
& update items that are HTTP/transport specific }
  if Result = 0 then
  begin
    if IsEqualGUID(IID, FIID) then
    begin
      FHTTPWebNode.SoapAction := InvRegistry.GetActionURIOfIID(IID);
    end;
  end;
end;

function TIdHTTPRIO.GetDomConverter: TOPToSoapDomConvert;
begin
  if not Assigned(FDomConverter) then
  begin
    FDomConverter := GetDefaultConverter;
    FConverter := FDomConverter as IOPConvert;
  end;
  Result := FDomConverter;
end;

procedure TIdHTTPRIO.SetDomConverter(Value: TOPToSoapDomConvert);
begin
  if Assigned(FDOMConverter) and (FDomConverter.Owner = Self) then
  begin
    FConverter := nil;
    if FDomConverter <> FDefaultConverter then
      FDomConverter.Free;
  end;
  FDomConverter := Value;
  if Value <> nil then
  begin
    FConverter := Value;
    FDomConverter.FreeNotification(Self);
    FDomConverter.WSDLView := FWSDLView;
  end;
end;

function TIdHTTPRIO.GetHTTPWebNode: TIdHTTPReqResp;
begin
  if not Assigned(FHTTPWebNode) then
  begin
    FHTTPWebNode := GetDefaultWebNode;
    FWebNode := FHTTPWebNode as IWebNode;
  end;
  Result := FHTTPWebNode;
end;

procedure TIdHTTPRIO.SetHTTPWebNode(Value: TIdHTTPReqResp);
var
  URL, UDDIOperator, UDDIBindingKey: string;
begin
  if Assigned(FHTTPWebNode) then
  begin
{ Save previous endpoint configuration }
    URL := FHTTPWebNode.URL;
{ Cleanup if we're owner and it's not out default one }
    if (FHTTPWebNode.Owner = Self) and (FHTTPWebNode <> FDefaultWebNode) then
    begin
      FWebNode := nil;
      FHTTPWebNode.Free;
    end
  end
  else
  begin
    URL := '';
    UDDIOperator := '';
    UDDIBindingKey := '';
  end;
  FHTTPWebNode := Value;
  if Value <> nil then
  begin
    FWebNode := Value;
  { Make sure we get notified so we may cleanup properly }
    FHTTPWebNode.FreeNotification(Self);
  { WSDLView }
    FHTTPWebNode.WSDLView := FWSDLView;
  end
  else
  begin
    FHTTPWebNode := FDefaultWebNode;
    FWebNode := FHTTPWebNode as IWebNode;
  end;
  { Transfer previous endpoint configuration }
  if FHTTPWebNode <> nil then
  begin
    if (URL <> '') and (FHTTPWebNode.URL = '') then
      FHTTPWebNode.URL := URL;
  end;
end;

function TIdHTTPRIO.GetURL: string;
begin
  if Assigned(FHTTPWebNode) then
    Result := FHTTPWebNode.URL
  else
    Result := '';
end;

procedure TIdHTTPRIO.Notification(AComponent: TComponent;
Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FHTTPWebNode) then
  begin
    FWebNode := nil;
    FHTTPWebNode := nil;
  end;
  if (Operation = opRemove) and (AComponent = FDomConverter) then
  begin
    FConverter := nil;
    FDomConverter := nil;
  end;
end;

end.