⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uaserviceclient.pas

📁 基于Midas 技术的多层应用开发包第二版(带开发文档)
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  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 + -