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

📄 uasrvobj.~pas

📁 基于Midas 技术的多层应用开发包第二版(带开发文档)
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
    if Assigned(adoQry) then
      FreeAndNil(adoQry);
  end;

end;

procedure TuaServerObject.Execute(ServiceName: WideString; DataIn: OleVariant;
  var DataOut: OleVariant);

begin


  InitForExecute(DataIn,DataOut);
  CurrServiceName := Trim(ServiceName);
  OperationTypes  := otExecute;

end;

function TuaServerObject.GetAllRecCount(var TableName:string;const sWhere:string= ''): integer;
var
  adoDS:TAdoDataSet;
  sSql:string;
begin

  Result := 0;
  if not Assigned(DbConnection) then Exit;
  if trim(TableName) <> '' then
  begin
    adoDS := TAdoDataSet.Create(Self);
    adoDS.Connection := DbConnection;
    adoDS.Name := UniqueName(adoDS,'GetRecCount_adoDS',Self);
    try
      try
        // -- modify by vinson zeng 2004-07-27-----
        sSql := Format('select count(*)  from   %s ',[TableName]);
        //sSql := Format('select rows from sysindexes where id=OBJECT_ID("%s") and indid<2',[TableName]);
        //--- %% end of %% ------------------------
        if Trim(sWhere) <> '' then
          sSql := sSql + ' where ' +sWhere;
        adoDS.CommandText := sSql;
        adoDS.Open;
        Result := adoDS.Fields[0].AsInteger;
      except  //do not catch error
        on E:Exception do
           begin
             MakeUAExceptionMsg(UA_E_PHY_RECCOUNT,E,GetMsSqlLastError());
           end;
      end;
    finally
      if Assigned(adoDS) then
        FreeAndNil(adoDS);
    end;
  end;

end;

procedure TuaServerObject.InitForExecute(var DataIn, DataOut: OleVariant);
begin

  FUAExecuteDataInPacket.ClearAllUaData;
  FUAExecuteDataOutPacket.ClearAllUaData;
  FUAExecuteDataInPacket.UAData := DataIn;
  FDBName := FUAExecuteDataInPacket.DBConnTag // add by vinson zeng 2004-3-16;
  
end;

procedure TuaServerObject.InitForRequest(var DataIn, DataOut: OleVariant);
begin

  FUARequestDataInPacket.ClearAllUaData;
  FUARequestDataOutPacket.ClearAllUaData;
  FUARequestDataInPacket.UAData := DataIn;
  FDBName := FUARequestDataInPacket.DBConnTag; // add by vinson zeng 2004-3-16

end;

procedure TuaServerObject.InitForUpdate(var DataIn, DataOut: OleVariant);
begin

  FUAUpdateDataInPacket.ClearAllUaData;
  FUAUpdateDataOutPacket.ClearAllUaData;
  FUAUpdateDataInPacket.UAData := DataIn;
  FDBName := FUAUpdateDataInPacket.DBConnTag; // add by vinson zeng 2004-3-16
  
end;

function TuaServerObject.InSyncTrans: Boolean;
begin
  Result := DbConnection.InTransaction;
end;

function TuaServerObject.QueryData(Sender: TObject;var vOutData: OleVariant): integer;
var

  sSql,sTableName,sKeys,sParams,
  sMasterLink,sRowSheet:string;

  j,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
  aDataRequestParam:TDataRequestParam;
  aDataReturnParam:TDataReturnParam;
  aRowSheetParam:TRowSheetParam;
  sKeyList:TStringList;

  //------%% begin declare %%--------
  adoQuery:TAdoDataSet;
  dspQuery:TDataSetProvider;
  cdsQuery:TClientDataSet;
  //----------%% end of %%-----------

  aTmpOut:TUARequestDataOutPacket;

begin

  Result := 0;

  with FUARequestDataInPacket do
  begin

    adoQuery := TAdoDataSet.Create(Self);
    adoQuery.EnableBCD := true;
    adoQuery.Name := UniqueName(adoQuery,'adoQuery',Self);

    dspQuery := TDataSetProvider.Create(Self);
    dspQuery.Name := UniqueName(dspQuery,'dspQuery',Self);

    cdsQuery := TClientDataSet.Create(Self);
    cdsQuery.Name := UniqueName(cdsQuery,'cdsQuery',Self);


    aDataRequestParam := TDataRequestParam.Create;
    aDataReturnParam  := TDataReturnParam.Create;

    aTmpOut := TUARequestDataOutPacket.Create;

    try
      try

        if CountMasterLink <> 0 then
          sMasterLink := BuildMasterLinkSqlScript(FUARequestDataInPacket);

        if CountRowSheet <> 0 then
          sRowSheet := BuildRowSheetSqlScript(FUARequestDataInPacket);

        aDataRequestParam := GetItemRequestData(0);
        sTableName := aDataRequestParam.AliasTableName;
        iRequestCount := aDataRequestParam.RequestRecCount;
        iCurrCount := aDataRequestParam.CurrRecCount;
        sKeys := aDataRequestParam.KeyFields;
        sParams := aDataRequestParam.SqlParams;

        if MustGetRecCount = 0 then // modify by vinson zeng
        begin
          if trim(sMasterLink) <> '' then   //2004-03-28 will be modify
          begin
  //          if trim(sParams) <> '' then
  //           iAllCount := GetAllRecCount(sTableName,sMasterLink + ' and '+sParams )
  //          else
             iAllCount := GetAllRecCount(sTableName,sMasterLink);

          end
          else begin                      //2004-03-28
  //          if trim(sParams) <> '' then
  //           iAllCount := GetAllRecCount(sTableName,sParams )
  //          else
             iAllCount := GetAllRecCount(sTableName,'');
          end;
        end;

        sSql := Format('select  *  from  %s ',[sTableName]);

        if Trim(sMasterLink) <>'' then
        begin
          sSql := sSql + ' where '+ sMasterLink;

          if Trim(sParams) <> '' then
              sSql := sSql + ' and ' + sParams

        end
        else begin
          if Trim(sParams) <> '' then
              sSql := sSql + ' where ' + sParams ;
        end;

        if Trim(sKeys) <> '' then
         sSql := sSql + ' order by ' + sKeys;


//        if iRequestCount <> -1 then
//          adoRequest.MaxRecords := iRequestCount;

        UADebugEx(ddRequest,Now(),Self,sSql);

        adoQuery.Connection := DbConnection;
        adoQuery.CommandText := sSql;
        iOpenCount := OpenSrvData(adoQuery,dspQuery,cdsQuery);

      except
        Result := -1;
      end;

    finally
       //-------%%begin build ReturnDataPacket %%----------
       if Result = 0 then
       begin
         //当iRequestCount = -1 时候,代表是下载全部数据!
         if (iRequestCount <> -1) {or (CountRowSheet = 0)}then
         begin
           if iAllCount > (iOpenCount + iCurrCount) then
           begin // begin build Tag
             if cdsQuery.Active then
             begin
               sKeyList := TStringList.Create;
               xStrSplit(sKeys,[','],sKeyList,true,true);
               try
                 cdsQuery.DisableControls;
                 while not cdsQuery.Eof do
                 begin
                   for j := 0 to sKeyList.Count -1 do
                   begin
                     aRowSheetParam := TRowSheetParam.Create;
                     aRowSheetParam.AliasTableName := sTableName;
                     aRowSheetParam.FieldName :=  sKeyList.Strings[j];
                     aRowSheetParam.FieldType := cdsQuery.FindField(sKeyList.Strings[j]).DataType;
                     aRowSheetParam.CurrValue := cdsQuery.FindField(sKeyList.Strings[j]).Value;
                     aTmpOut.AddItemRowSheet(aRowSheetParam);
                   end;
                  cdsQuery.Next;
                 end;
               finally
                 cdsQuery.EnableControls;
                 if Assigned(sKeyList) then
                   FreeAndNil(sKeyList);
               end;
             end;
           end;
         end;
         if cdsQuery.Active then
         begin
           aDataReturnParam.AllRecCount := iAllCount;
           aDataReturnParam.Data := cdsQuery.Data;
           aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
           aTmpOut.AddItemReturnData(aDataReturnParam);
         end;
         vOutData := aTmpOut.UAData;
       end;
       //-------%% end of %%-------------------------------
       if Assigned(aTmpOut) then
         FreeAndNil(aTmpOut);
       ReleaseAllDS(adoQuery,dspQuery,cdsQuery);
    end;
  end;

end;

function TuaServerObject.OpenSrvData(adoDS: TAdoDataSet;Dsp: TDataSetProvider; Cds: TClientDataSet):integer;
begin

  Result := 0;

  if (not Assigned(adoDS)) or (not Assigned(Dsp)) or (not Assigned(Cds)) then Exit;

  try
    adoDS.Close;
    Dsp.DataSet := nil ;
    Cds.ProviderName :='';
    Cds.close;

    adoDS.Open;
    Dsp.DataSet := adoDS;
    Cds.ProviderName := Dsp.Name;
    Cds.Open;
    Dsp.Options := Dsp.Options + [poIncFieldProps];
    Result := Cds.RecordCount;
  except
    on E:Exception do
       begin
         Result := -1;
         MakeUAExceptionMsg(UA_E_OPEN_TABLE,E,GetMsSqlLastError());
       end;
  end;

end;

function TuaServerObject.RefreshData(Sender: TObject;
  var vOutData: OleVariant): integer;
var

  sSql,sTableName,sKeys,sParams:string;

  j,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
  aDataRequestParam:TDataRequestParam;
  aDataReturnParam:TDataReturnParam;
//  sKeyList:TStringList;
  //------%% begin declare %%--------
  adoRefresh:TAdoDataSet;
  dspRefresh:TDataSetProvider;
  cdsRefresh:TClientDataSet;
  //----------%% end of %%-----------

  aTmpOut:TUARequestDataOutPacket;

begin

  Result := 0;

  with FUARequestDataInPacket do
  begin

    adoRefresh := TAdoDataSet.Create(Self);
    adoRefresh.EnableBCD := true;
    adoRefresh.Name := UniqueName(adoRefresh,'adoRefresh',Self);

    dspRefresh := TDataSetProvider.Create(Self);
    dspRefresh.Name := UniqueName(dspRefresh,'dspRefresh',Self);

    cdsRefresh := TClientDataSet.Create(Self);
    cdsRefresh.Name := UniqueName(cdsRefresh,'cdsRefresh',Self);


    aDataRequestParam := TDataRequestParam.Create;
    aDataReturnParam  := TDataReturnParam.Create;

    aTmpOut := TUARequestDataOutPacket.Create;

    try
      try

        aDataRequestParam := GetItemRequestData(0);
        sTableName := aDataRequestParam.AliasTableName;
        iRequestCount := aDataRequestParam.RequestRecCount;
        iCurrCount := aDataRequestParam.CurrRecCount;
        sKeys := aDataRequestParam.KeyFields;
        sParams := aDataRequestParam.SqlParams;

        if MustGetRecCount = 0 then
          iAllCount := GetAllRecCount(sTableName,'');     //2004-03-28

        sSql := Format('select  *  from  %s ',[sTableName]);

        if Trim(sParams) <> '' then
           sSql := sSql + ' where ' + sParams ;

        if Trim(sKeys) <> '' then
         sSql := sSql + ' order by ' + sKeys;


        UADebugEx(ddRequest,Now(),Self,sSql);

        adoRefresh.Connection := DbConnection;
        adoRefresh.CommandText := sSql;
        iOpenCount := OpenSrvData(adoRefresh,dspRefresh,cdsRefresh);

      except
        Result := -1;
      end;

    finally
       //-------%%begin build ReturnDataPacket %%----------
       if Result = 0 then
       begin
         if cdsRefresh.Active then
         begin
           aDataReturnParam.AllRecCount := iAllCount;
           aDataReturnParam.Data := cdsRefresh.Data;
           aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
           aTmpOut.AddItemReturnData(aDataReturnParam);
         end;
         vOutData := aTmpOut.UAData;
       end;
       //-------%% end of %%-------------------------------
       if Assigned(aTmpOut) then
         FreeAndNil(aTmpOut);
       ReleaseAllDS(adoRefresh,dspRefresh,cdsRefresh);
    end;
  end;

end;

function TuaServerObject.ReleaseAllDS(adoDS: TAdoDataSet;
  Dsp: TDataSetProvider; Cds: TClientDataSet): integer;
begin

  Result := 0;
  if (not Assigned(adoDS)) or (not Assigned(Dsp)) or (not Assigned(Cds)) then Exit;
  try
    adoDS.Close;
    Dsp.DataSet := nil ;
    Cds.ProviderName :='';
    Cds.close;

    FreeAndNil(adoDS);
    FreeAndNil(dsp);
    FreeAndNil(cds);

  except
    Result := -1;
  end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -