uaserviceclient.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

{******************************************************************************************}
{                                                                                          }
{       Universal Agent on demond SDK                                                      }
{                                                                                          }
{                                                                                          }
{ COPYRIGHT                                                                                }
{ =========                                                                                }
{ The UA SDK (software) is Copyright (C) 2001-2003, by vinson zeng(曾胡龙).                }
{ All rights reserved.                                                                     }
{ The authors - vinson zeng (曾胡龙),                                                      }
{ exclusively own all copyrights to the Advanced Application                               }
{ Controls (AppControls) and all other products distributed by Utilmind Solutions(R).      }
{                                                                                          }
{ LIABILITY DISCLAIMER                                                                     }
{ ====================                                                                     }
{ THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO PERFORMANCE            }
{ OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.                 }
{ YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR DATA LOSS,                }
{ DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS SOFTWARE.}
{                                                                                          }
{ RESTRICTIONS                                                                             }
{ ============                                                                             }
{ You may not attempt to reverse compile, modify,                                          }
{ translate or disassemble the software in whole or in part.                               }
{ You may not remove or modify any copyright notice or the method by which                 }
{ it may be invoked.                                                                       }
{******************************************************************************************}

unit UAServiceClient;


interface
uses

   SysUtils, Messages, Classes, Dialogs,Forms,Controls,
   UAServiceAdapter,UADataPacket,Variants,
   UAUnits,UAErrorHandler;

type

  TBeforeCallSrvObjService = procedure (Sender:TObject) of Object;
  TAfterCallSrvObjService  = procedure (Sender:TObject; var bHandle:Boolean) of Object;
  
  TUAServiceClient = class(TComponent)
  private

    FSrvObjName:string;
    FUAServiceAdapter:TUAServiceAdapter;
    FActive:Boolean;

    FBeforeCallSrvObjForRequest:TBeforeCallSrvObjService;
    FAfterCallSrvObjForRequest:TAfterCallSrvObjService;

    FBeforeCallSrvObjForUpdate:TBeforeCallSrvObjService;
    FAfterCallSrvObjForUpdate:TAfterCallSrvObjService;

    FBeforeCallSrvObjForExecute:TBeforeCallSrvObjService;
    FAfterCallSrvObjForExecute:TAfterCallSrvObjService;

    FUARequestDataInPacket:TUARequestDataInPacket;
    FUARequestDataOutPacket:TUARequestDataOutPacket;
    FUAUpdateDataInPacket:TUAUpdateDataInPacket;
    FUAUpdateDataOutPacket:TUAUpdateDataOutPacket;
    FUAExecuteDataInPacket:TUAExecuteDataInPacket;
    FUAExecuteDataOutPacket:TUAExecuteDataOutPacket;

    function  GetUAServiceAdapter: TUAServiceAdapter;
    procedure SetUAServiceAdapter(const Value: TUAServiceAdapter);
    function  GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    function  GetSrvObjName: string;
    procedure SetSrvObjName(const Value: string);

    function GetUAExecuteDataInPacket: TUAExecuteDataInPacket;
    function GetUAExecuteDataOutPacket: TUAExecuteDataOutPacket;
    function GetUARequestDataInPacket: TUARequestDataInPacket;
    function GetUARequestDataOutPacket: TUARequestDataOutPacket;
    function GetUAUpdateDataInPacket: TUAUpdateDataInPacket;
    function GetUAUpdateDataOutPacket: TUAUpdateDataOutPacket;

  protected

    FUAErrorHandlerEx:TUAErrorHandlerEx;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
    function  CheckServiceProp(Sender:TObject):Boolean;
    function  CheckErrorLevel(iType:integer;var vReturnValue:OleVariant):integer;
    procedure RaiseUAErrorMsg(Sender:TObject;LUADataPacketType:TUADataPacketType;var vValue:OleVariant);

  public

    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure ClearRequestParams;
    procedure ClearUpdateParams;
    procedure ClearExecueParams;

    function  DoRequest(ServiceName:string;const RequestIndex:Integer= -1):integer;
    function  DoUpdate (ServiceName:string;const iUpdateIndex:Integer = -1):integer;virtual;
    function  DoExecute(ServiceName:string):integer;virtual;

    property  UARequestDataInPacket:TUARequestDataInPacket read GetUARequestDataInPacket;
    property  UARequestDataOutPacket:TUARequestDataOutPacket read GetUARequestDataOutPacket;
    property  UAUpdateDataInPacket:TUAUpdateDataInPacket read GetUAUpdateDataInPacket;
    property  UAUpdateDataOutPacket:TUAUpdateDataOutPacket read GetUAUpdateDataOutPacket;
    property  UAExecuteDataInPacket:TUAExecuteDataInPacket read GetUAExecuteDataInPacket;
    property  UAExecuteDataOutPacket:TUAExecuteDataOutPacket read GetUAExecuteDataOutPacket;

  published

    property Active:Boolean read GetActive write SetActive default false;
    property UAServiceAdapter:TUAServiceAdapter read GetUAServiceAdapter write SetUAServiceAdapter;
    property SrvObjName:string read GetSrvObjName write SetSrvObjName;
    property BeforeCallSrvObjForRequest:TBeforeCallSrvObjService read FBeforeCallSrvObjForRequest write FBeforeCallSrvObjForRequest;
    property AfterCallSrvObjForRequest:TAfterCallSrvObjService read FAfterCallSrvObjForRequest write FAfterCallSrvObjForRequest;
    property BeforeCallSrvObjForUpdate:TBeforeCallSrvObjService read FBeforeCallSrvObjForUpdate write FBeforeCallSrvObjForUpdate;
    property AfterCallSrvObjForUpdate:TAfterCallSrvObjService read FAfterCallSrvObjForUpdate write FAfterCallSrvObjForUpdate;
    property BeforeCallSrvObjForExecute:TBeforeCallSrvObjService read FBeforeCallSrvObjForExecute write FBeforeCallSrvObjForExecute;
    property AfterCallSrvObjForExecute:TAfterCallSrvObjService read FAfterCallSrvObjForExecute  write FAfterCallSrvObjForExecute;

  end;


implementation

{ TUAServiceClient }

function TUAServiceClient.CheckErrorLevel(iType: integer;var vReturnValue: OleVariant): integer;
var
  aRequest:TUARequestDataOutPacket;
  aUpdate:TUAUpdateDataOutPacket;
  aExecute:TUAExecuteDataOutPacket;
begin

  Result := 0;
//0 Request 1 Update 2:Execute
  case iType of
    0: begin
         aRequest := TUARequestDataOutPacket.Create;
         try
           try
             aRequest.UAData := vReturnValue;
             Result := aRequest.ResultCode;
           except
             Result := -10003
           end
         finally
           if Assigned(aRequest) then
             FreeAndNil(aRequest);
         end;
       end;
    1: begin
         aUpdate := TUAUpdateDataOutPacket.Create;
         try
           try
             aUpdate.UAData := vReturnValue;
             Result := aUpdate.ResultCode;
           except
             Result := -10003
           end;
         finally
           if Assigned(aUpdate) then
             FreeAndNil(aUpdate);
         end;
       end;
    2: begin
         aExecute := TUAExecuteDataOutPacket.Create;
         try
           try
             aExecute.UAData := vReturnValue;
             Result := aExecute.ResultCode;
           except
             Result := -10003
           end;
         finally
           if Assigned(aExecute) then
             FreeAndNil(aExecute);
         end;
       end;
  end;

end;

function TUAServiceClient.CheckServiceProp(Sender: TObject): Boolean;
begin
  Result := true;
  if not Assigned(FUAServiceAdapter) then
    Result := false;
end;

procedure TUAServiceClient.ClearExecueParams;
begin
  UAExecuteDataInPacket.ClearAllUaData;
  UAExecuteDataOutPacket.ClearAllUaData;
end;

procedure TUAServiceClient.ClearRequestParams;
begin
  UARequestDataInPacket.ClearAllUaData;
  UARequestDataOutPacket.ClearAllUaData;
end;

procedure TUAServiceClient.ClearUpdateParams;
begin
  UAUpdateDataInPacket.ClearAllUaData;
  UAUpdateDataOutPacket.ClearAllUaData;
end;

constructor TUAServiceClient.Create(AOwner: TComponent);
begin
  inherited;

  FActive := false;

  FUARequestDataInPacket := TUARequestDataInPacket.Create;
  FUARequestDataOutPacket:= TUARequestDataOutPacket.Create;
  FUAUpdateDataInPacket  := TUAUpdateDataInPacket.Create;
  FUAUpdateDataOutPacket := TUAUpdateDataOutPacket.Create;
  FUAExecuteDataInPacket := TUAExecuteDataInPacket.Create;
  FUAExecuteDataOutPacket:= TUAExecuteDataOutPacket.Create;
  FUAErrorHandlerEx := TUAErrorHandlerEx.Create(Self);
  FUAErrorHandlerEx.LogFile := Application.Name + '_ErrorLog';

end;

destructor TUAServiceClient.Destroy;
begin

  FUARequestDataInPacket.Free ;
  FUARequestDataOutPacket.Free;
  FUAUpdateDataInPacket.Free  ;
  FUAUpdateDataOutPacket.Free ;
  FUAExecuteDataInPacket.Free ;
  FUAExecuteDataOutPacket.Free;
  FUAErrorHandlerEx.Free;
  inherited;

end;


function TUAServiceClient.DoExecute(ServiceName:string):integer;
var
  bContinue:Boolean;
  vOut:OleVariant;
begin

  bContinue := false;
  Result := 0;
  if (trim(ServiceName) = '') or (trim(SrvObjName) ='') then Exit;

  if not CheckServiceProp(Self) then
  begin
    MessageDlg('do not finish service define,please check!', mtError,[mbOk], 0);
    Exit;
  end;