uasrvobj.~pas

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

end;

procedure TuaServerObject.Request(ServiceName: WideString; DataIn: OleVariant;
  var DataOut: OleVariant);
var
  bHandle:Boolean;
  bContinue:Boolean;
  aOut:OleVariant;
  iMaxError:integer;
begin

  bContinue := true;
  bHandle := true;

  InitForRequest(DataIn,DataOut);

  CurrServiceName := Trim(ServiceName);
  OperationTypes  := otRequest;

  try
    try
      ExLockDbConnection;
      BeforeRequest(Self,bHandle);
      if bHandle then
      begin
        if LowerCase(ServiceName) ='requestalldata' then
        begin
          RequestData(Self,aOut);
        end
        else
        if LowerCase(ServiceName) ='refreshdata' then
        begin
          RefreshData(Self,aOut);
        end
        else
        if LowerCase(ServiceName)='querydata' then
        begin
          QueryData(Self,aOut)
        end
        else
        begin
          RequestCustomData(ServiceName,DataIn,aOut);
        end;
      end
      else
      begin


      end;
    except
      on E:Exception do
         begin
           iMaxError := MakeUAExceptionMsg(UA_E_FATUALERROR,E,ServiceName);
         end;
    end;
  finally
    AfterRequest(Self,bContinue);
    ExUnlockDbConnection;
    if (not VarIsEmpty(aOut)) and (VarIsArray(aOut)) and
      (VarCompareValue(aOut,Unassigned)<> vrEqual)  and  bContinue then
    begin
      if FUARequestDataOutPacket.CountErrorParam = 0 then
       FUARequestDataOutPacket.UAData := aOut;
    end
    else
    begin

    end;
    DataOut := FUARequestDataOutPacket.UAData;
  end;

end;


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

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

  j,k,iAllCount,iCurrCount,iRequestCount,iOpenCount:integer;
  aDataRequestParam:TDataRequestParam;
  aDataReturnParam:TDataReturnParam;
  aDataSheetParam:TDataSheetParam;
  sKeyList:TStringList;

  //------%% begin declare %%--------
  adoRequest:TAdoDataSet;
  dspRequest:TDataSetProvider;
  cdsRequest:TClientDataSet;
  //----------%% end of %%-----------

  aTmpOut:TUARequestDataOutPacket;
//  sErrorMsg:string;
//  sErrorContext:string;

begin

  Result := 0;

  with FUARequestDataInPacket do
  begin

    adoRequest := TAdoDataSet.Create(Self);
    adoRequest.EnableBCD := true; // fix by vinson zeng
    adoRequest.Name := UniqueName(adoRequest,'adoRequest',Self);

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

    cdsRequest := TClientDataSet.Create(Self);
    cdsRequest.Name := UniqueName(cdsRequest,'cdsRequest',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
        begin
          if trim(sMasterLink) <> '' then  //2004-03-28
          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;

        case RequestType of
          -1: begin
                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;
              end;
           1: begin

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

                for k := 0 to FUARequestDataInPacket.CountDataSheet -1 do
                begin
                  if Trim(sTmpSql) <> '' then sTmpSql := sTmpSql + 'and ';
                  sTmpSql := sTmpSql + '( '+ GetItemDataSheet(k).FieldName
                             + GetItemDataSheet(k).RelSymbol + FieldValueToSqlStr(GetItemDataSheet(k).FieldType,GetItemDataSheet(k).LastValue)
                             +' )';
                end;
                if Trim(sTmpSql) <> '' then sTmpSql := '( '+sTmpSql+' )';


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

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

                  if Trim(sParams) <> '' then
                  begin
                    if trim(sTmpSql) <> '' then
                      sSql := sSql +   ' and ' + sParams
                    else
                      sSql := sSql + ' where '+  sParams;
                  end;
                //fix bug 2003-10-31 vinson zeng
                  if Trim(sRowSheet) <> '' then
                  begin
                    if (trim(sParams) <> '') or (trim(sTmpSql) <> '') then
                      sSql := sSql + ' and  '+ sRowSheet
                    else
                      sSql := sSql + ' where '+ sRowSheet;

                  end;
                end;

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

              end;

        end;

        if iRequestCount <> -1 then
          adoRequest.MaxRecords := iRequestCount;
        UADebugEx(ddRequest,Now(),Self,sSql);
        adoRequest.Connection := DbConnection;
        adoRequest.CommandText := sSql;
        iOpenCount := OpenSrvData(adoRequest,dspRequest,cdsRequest);
     except  //do not catch error
       on E:Exception do
          begin
            Result := -1;
            MakeUAExceptionMsg(UA_E_DB_CONNECT,E,GetMsSqlLastError());
          end;
      end;
    finally

       //-------%%begin build ReturnDataPacket %%----------
       if Result = 0 then
       begin
         if iRequestCount <> -1 then
         begin
           if iAllCount > (iOpenCount + iCurrCount) then
           begin // begin build Tag
             if cdsRequest.Active then
             begin
               sKeyList := TStringList.Create;
               xStrSplit(sKeys,[','],sKeyList,true,true);
               try
                 cdsRequest.DisableControls;
                 cdsRequest.Last;
                 for j := 0 to sKeyList.Count -1 do
                 begin
                   aDataSheetParam := TDataSheetParam.Create;
                   aDataSheetParam.AliasTableName := sTableName;
                   aDataSheetParam.FieldName :=  sKeyList.Strings[j];
                   aDataSheetParam.RelSymbol := '>';
                   aDataSheetParam.FieldType := cdsRequest.FindField(sKeyList.Strings[j]).DataType;
                   aDataSheetParam.LastValue := cdsRequest.FindField(sKeyList.Strings[j]).Value;
                   aTmpOut.AddItemDataSheet(aDataSheetParam);
                 end;
               finally
                 cdsRequest.EnableControls;
                 if Assigned(sKeyList) then
                   FreeAndNil(sKeyList);
               end;
             end;

           end;
         end;
         if cdsRequest.Active then
         begin
           aDataReturnParam.AllRecCount := iAllCount;
           aDataReturnParam.Data := cdsRequest.Data;
           aDataReturnParam.CurrRecCount := iOpenCount + iCurrCount;
           aTmpOut.AddItemReturnData(aDataReturnParam);
         end;
         vOutData := aTmpOut.UAData;
       end;
       //-------%% end of %%-------------------------------
       if Assigned(aTmpOut) then
         FreeAndNil(aTmpOut);

       ReleaseAllDS(adoRequest,dspRequest,cdsRequest);

    end;
  end;
end;

procedure TuaServerObject.RollbackSyncTrans;
begin
  if InSyncTrans and (not FSyncTransaction) then
  begin
    DbConnection.RollbackTrans;
    UADebugEx(ddRollbackTrans,Now(),DbConnection,'RollBack Transaction');
  end;
end;


procedure TuaServerObject.SetOperationType(const Value: TOperationType);
begin
  FOperationTypes := Value;
end;

procedure TuaServerObject.SetPrepare(const Value: Boolean);
begin

  if Value then
  begin
    if not FPrepare then
    begin

    end;
    FPrepare := Value;
  end
  else begin
    if FPrePare then
    begin

    end;
    FPrepare := Value;
  end;

end;

procedure TuaServerObject.StartSyncTrans;
begin

  if InSyncTrans  then
    RollbackSyncTrans;
  if not FSyncTransaction then
  begin
    DbConnection.BeginTrans;
    UADebugEx(ddStartTrans,Now(),DbConnection,'Start Transaction On :');
  end;

end;


{-----------------------------------------------------------------------------
  Procedure: TuaServerObject.SubmitAllDelta
  Author:    vinson zeng
  Date:      04-三月-2004
  Arguments: bStartTrans: Boolean;AllDelta: OleVariant
  Result:    integer
-----------------------------------------------------------------------------}

function TuaServerObject.SubmitAllDelta(bStartTrans: Boolean;AllDelta: OleVariant):integer;
var

  i,j,iResult,iError:integer;
  lStrList:TStringList;
  aDeltaParam:TDeltaParam;
  aTmpCDS:TClientDataSet;
  FKeyFields: array of string;

begin

  iResult := 0;

  // 使用等待信号灯锁，目的是为了提高并发效率，降低（消除）DBMS死锁
//  if WaitForSingleObject(FSemaphore, 2000) = WAIT_FAILED then  // wait 2 second

  if bStartTrans then
    StartSyncTrans;

  try
    for i := VarArrayHighBound(AllDelta,1) downto VarArrayLowBound(AllDelta,1) do
//    for i := VarArrayLowBound(AllDelta,1) to VarArrayHighBound(AllDelta,1) do
    begin

      lStrList := TStringList.Create;

      iError := 0;
      aTmpCDS := TClientDataSet.Create(Self);
      aTmpCDS.Name := UniqueName(aTmpCDS,'SubmitDelta_TmpCds',Self);

      aDeltaParam := TDeltaParam.Create;
      aDeltaParam.UAData := AllDelta[i];
      try
        with aDeltaParam do
        begin
          if (Trim(AliasTableName) = '') or (Trim(KeyFields) = '') then
          begin
            Inc(iResult);
            Continue;
          end;
          xStrSplit(KeyFields,[','],lStrList,true,true);