📄 uaserviceclient.pas
字号:
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 programer do 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 not do 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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -