Universal Agent on demond SDK --UAServiceClient(0分)

{******************************************************************************************}
{ }
{ 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 do
Request(ServiceName:string;const RequestIndex:Integer= -1):integer;
function do
Update (ServiceName:string;const iUpdateIndex:Integer = -1):integer;virtual;
function do
Execute(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;

if trim(UAServiceAdapter.ActiveDBName) <> '' then
//add by vinson zeng 2004-3-16
UAExecuteDataInPacket.DBConnTag := UAServiceAdapter.ActiveDBName
else
UAExecuteDataInPacket.DBConnTag := UAServiceAdapter.DefaultDBName;
if Assigned(FBeforeCallSrvObjForExecute) then
FBeforeCallSrvObjForExecute(Self);
//do Execute in here
Screen.Cursor := crSQLWait;
UAServiceAdapter.Execute(SrvObjName,ServiceName,UAExecuteDataInPacket.UAData,vOut);
Screen.Cursor := crDefault;
if Assigned(FAfterCallSrvObjForExecute) then
FAfterCallSrvObjForExecute(Self,bContinue);
if CheckErrorLevel(2,vOut) <> 0 then
begin
RaiseUAErrorMsg(Application,dtpExecute,vOut);
VarClear(vOut);
Result := -1;
end;

if not bContinue then
begin
if (VarCompareValue(vOut,Unassigned)<> vrEqual) and
(VarIsArray(vOut)) and (not VarIsEmpty(vOut)) then
UAExecuteDataOutPacket.UAData := vOut;
end;

end;

function TUAServiceClient.DoRequest(ServiceName:string;const RequestIndex:Integer= -1):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;

// must clear all request params before call request service
UARequestDataInPacket.RequestType := RequestIndex;
if trim(UAServiceAdapter.ActiveDBName) <> '' then
//add by vinson zeng 2004-3-16
UARequestDataInPacket.DBConnTag := UAServiceAdapter.ActiveDBName
else
UARequestDataInPacket.DBConnTag := UAServiceAdapter.DefaultDBName;

if Assigned(FBeforeCallSrvObjForRequest) then
FBeforeCallSrvObjForRequest(Self);
//do request in here
UAServiceAdapter.Request(SrvObjName,ServiceName,UARequestDataInPacket.UAData,vOut);
if Assigned(FAfterCallSrvObjForRequest) then
FAfterCallSrvObjForRequest(Self,bContinue);
// can be handle all by for programerdo
he define code;
if CheckErrorLevel(0,vOut) <> 0 then
begin
RaiseUAErrorMsg(Application,dtpRequest,vOut);
VarClear(vOut);
Result := -1;
end;

if not bContinue then
begin
if (VarCompareValue(vOut,Unassigned)<> vrEqual) and
(VarIsArray(vOut)) and (not VarIsEmpty(vOut)) then
UARequestDataOutPacket.UAData := vOut;
if (RequestIndex = -1 ) or (RequestIndex = 1) then
begin
// blank notdo
anything
end;
end;

end;

function TUAServiceClient.DoUpdate(ServiceName:string;const iUpdateIndex:Integer = -1):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;

UAUpdateDataInPacket.UpdateIndex := iUpdateIndex;
if trim(UAServiceAdapter.ActiveDBName) <> '' then
//add by vinson zeng 2004-3-16
UAUpdateDataInPacket.DBConnTag := UAServiceAdapter.ActiveDBName
else
UAUpdateDataInPacket.DBConnTag := UAServiceAdapter.DefaultDBName;
if Assigned(FBeforeCallSrvObjForUpdate) then
FBeforeCallSrvObjForUpdate(Self);

//do update in here
UAServiceAdapter.Update(SrvObjName,ServiceName,UAUpdateDataInPacket.UAData,vOut);

if Assigned(FAfterCallSrvObjForUpdate) then
FAfterCallSrvObjForUpdate(Self,bContinue);
if CheckErrorLevel(1,vOut) <> 0 then
begin

RaiseUAErrorMsg(Application,dtpUpdate,vOut);
VarClear(vOut);
Result := -1;
end;

if not bContinue then
begin
if (VarCompareValue(vOut,Unassigned)<> vrEqual) and
(VarIsArray(vOut)) and (not VarIsEmpty(vOut)) then

UAUpdateDataOutPacket.UAData := vOut;
end;

end;

function TUAServiceClient.GetActive: Boolean;
begin
Result := FActive;
end;

function TUAServiceClient.GetSrvObjName: string;
begin
Result := FSrvObjName;
end;

function TUAServiceClient.GetUAExecuteDataInPacket: TUAExecuteDataInPacket;
begin
Result := FUAExecuteDataInPacket;
end;

function TUAServiceClient.GetUAExecuteDataOutPacket: TUAExecuteDataOutPacket;
begin
Result := FUAExecuteDataOutPacket;
end;

function TUAServiceClient.GetUARequestDataInPacket: TUARequestDataInPacket;
begin
Result := FUARequestDataInPacket;
end;

function TUAServiceClient.GetUARequestDataOutPacket: TUARequestDataOutPacket;
begin
Result := FUARequestDataOutPacket;
end;

function TUAServiceClient.GetUAServiceAdapter: TUAServiceAdapter;
begin
Result := FUAServiceAdapter;
end;

function TUAServiceClient.GetUAUpdateDataInPacket: TUAUpdateDataInPacket;
begin
Result := FUAUpdateDataInPacket;
end;

function TUAServiceClient.GetUAUpdateDataOutPacket: TUAUpdateDataOutPacket;
begin
Result := FUAUpdateDataOutPacket;
end;

procedure TUAServiceClient.Notification(AComponent: TComponent;
Operation: TOperation);
begin

inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FUAServiceAdapter) then
FUAServiceAdapter := nil;
end;

procedure TUAServiceClient.RaiseUAErrorMsg(Sender:TObject;LUADataPacketType:TUADataPacketType;var vValue:OleVariant);
const
TErrorTitle :array [0..2] of string =
('远程数据下载请求发生错误！',
'远程数据更新请求发生错误！',
'远程事务执行请求发生错误！');
sCaption :string = 'UA 错误信息：';
begin

Application.ProcessMessages;
FUAErrorHandlerEx.Execute(sCaption +#13#10+TErrorTitle[Ord(LUADataPacketType)] vValue,LUADataPacketType);
end;

procedure TUAServiceClient.SetActive(const Value: Boolean);
begin

if Assigned(FUAServiceAdapter) then
begin
FActive := Value;
if FActive then
FUAServiceAdapter.Connected := true
else
FUAServiceAdapter.Connected := false;
end
else
begin
MessageDlg('can not active because no exist UAServiceAdapter Object!', mtWarning ,[mbOk], 0);
Exit;
end;

end;

procedure TUAServiceClient.SetSrvObjName(const Value: string);
begin
if Trim(Value) <> '' then
FSrvObjName := Value
else
FSrvObjName := '';
end;

procedure TUAServiceClient.SetUAServiceAdapter(
const Value: TUAServiceAdapter);
begin
if Value <> nil then
FUAServiceAdapter := Value
else
FUAServiceAdapter := nil;

end;

end.