uasrvobj.~pas

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

          SetLength(FKeyFields,lStrList.Count);
          for j := 0 to lStrList.Count -1 do
            FKeyFields[j] := lStrList.Strings[j];

          aTmpCDS.Data := Delta;
          iError := SubmitDelta(DbConnection,AliasTableName,aTmpCDS,FKeyFields, // error message must return
                               [upModifyOne, upInsert, upDeleteOne], 0,FUAUpdateDataOutPacket);
          if iError <> 0 then
            Inc(iResult);
        end;
      finally
        if Assigned(lStrList) then
          FreeAndNil(lStrList);
        if Assigned(aDeltaParam) then
          FreeAndNil(aDeltaParam);
        if Assigned(aTmpCDS) then
          FreeAndNil(aTmpCDS);
      end;
    end;
  except

  end;

  if iResult <> 0 then
  begin
    if bStartTrans then
     RollbackSyncTrans;
  end
  else begin
    if bStartTrans then
     CommitSyncTrans;
  end;

  Result := iResult ;


end;

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

  bContinue := true;
  bHandle := true;
  InitForUpdate(DataIn,DataOut);

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

  try
    try
      ExLockDbConnection;
      BeforeUpdate(Self,bHandle);      // can Start transaction begin here
      if bHandle then
      begin
        if LowerCase(ServiceName) ='submitalldelta' then
        begin
          if FUAUpdateDataInPacket.UpdateIndex = -1 then
          begin
            vDelta := BuildDeltaArray(FUAUpdateDataInPacket);
            if not FSyncTransaction then
              iSubmitError := SubmitAllDelta(true,vDelta)
            else
              iSubmitError := SubmitAllDelta(false,vDelta);
          end;
        end
        else
        begin
          UpdateCustomDelta(ServiceName,DataIn,aOut);
        end;
      end
      else
      begin
        // catch error
      end;
    except
      on E:Exception do
         begin
           iMaxError := MakeUAExceptionMsg(UA_E_FATUALERROR,E,ServiceName);
         end;
    end;
  finally
    AfterUpdate(Self,bContinue);  //must handle at here // can commit or rollback transaction in here
    ExUnlockDbConnection;
    FUAUpdateDataOutPacket.ResultCode := iSubmitError;
    DataOut := FUAUpdateDataOutPacket.UAData;

  end;

end;


procedure TuaServerObject.SetCurrServiceName(const Value: string);
begin
  FCurrServiceName := Value;
end;



function TuaServerObject.GetCurrServiceName: string;
begin
  Result := FCurrServiceName;
end;


function TuaServerObject.GetTableStru(vDataIn:OleVariant;var vOutData: OleVariant): integer;
var
  FAdoDsDesign:TAdoDataSet;
  FdspDesign:TDataSetProvider;
  FcdsDesign:TClientDataSet;
  sSql:string;
begin

  FAdoDsDesign := TAdoDataSet.Create(Application);
  FAdoDsDesign.EnableBCD := true;
  FAdoDsDesign.Name := UniqueName(FAdoDsDesign,'adodsdesign',nil);
  FdspDesign := TDataSetProvider.Create(Application);
  FdspDesign.Name := UniqueName(FdspDesign,'dspdesign',nil);
  FcdsDesign := TClientDataSet.Create(Application);
  FcdsDesign.Name := UniqueName(FcdsDesign,'cdsdesign',nil);

  try
    try
      sSql := Format('select top 0 * from  %s',[VarToStr(vDataIn)]);
      if trim(sSql)<> '' then
      begin
        FAdoDsDesign.Connection := DbConnection;
        FAdoDsDesign.CommandText := sSql;
        if OpenSrvData(FAdoDsDesign,FdspDesign,FcdsDesign) <> -1 then
        begin
          if FcdsDesign.Active then
            vOutData := FcdsDesign.Data;
        end;
      end;
    except
      on E:Exception do
         begin
           //catch AppServer Error Message
         end;
    end;
  finally
    if Assigned( FAdoDsDesign) then
      FreeAndNil( FAdoDsDesign);
    if Assigned(FdspDesign) then
      FreeAndNil(FdspDesign);
    if Assigned(FcdsDesign) then
      FreeAndNil(FcdsDesign);
  end;

end;

function TuaServerObject.GetUAErrorCount(OperationType: TOperationType): integer;
begin

  case OperationType of
    otRequest : Result := FUARequestDataOutPacket.CountErrorParam;
    otUpdate  : Result := FUAUpdateDataOutPacket.CountErrorParam;
    otExecute : Result := FUAExecuteDataOutPacket.CountErrorParam;
  end;

end;


{-----------------------------------------------------------------------------
  Procedure: TuaServerObject.SubmitDelta
  Author:    vinson zeng
  Date:      04-三月-2004
  Arguments: lAdoConn:TAdoConnection;sTblName:string;cdsSrc:TClientDataSet;
             lFieldKeys:array of string;UpdateType:TUAUpdateTypes;
             iFailMax:integer;var uaOut:TUAUpdateDataOutPacket
  Result:    integer
-----------------------------------------------------------------------------}

//未对Blob 字段进行处理
function TuaServerObject.SubmitDelta(lAdoConn:TAdoConnection;sTblName:string;cdsSrc:TClientDataSet;
                                     lFieldKeys:array of string;UpdateType:TUAUpdateTypes;
                                     iFailMax:integer;var uaOut:TUAUpdateDataOutPacket):integer;

var

  i,j,iOrgCount:integer;
  lField:TField;
  sSql,s1,sSqlSelect:string;
  v1:variant;
  adoU:TAdoCommand;
  bContinue:Boolean;
  cdsDest:TClientDataSet;
  adoSelect:TAdoDataSet;
  UpdateError:TUAUpdateErrorCode;
  aErrorCDS:TClientDataSet;
  bAtHandle,bBtHandle:Boolean;

begin

  bAtHandle := false;
  bBtHandle := false;

  Result := 0;
  adoU := nil;
  adoU := TAdoCommand.Create(Self);
  adoU.Name := UniqueName(adoU,'SubmitDelta_TmpAdoComm',Self);
  cdsDest := nil;
  cdsDest := TClientDataSet.Create(Self);
  cdsDest.Name := UniqueName(cdsDest,'SubmitDelta_CdsDest',Self);
  aErrorCDS := TClientDataSet.Create(Self);
  aErrorCDS.Name := UniqueName(aErrorCDS,'SubmitDelta_ErrorCds',Self);
  try
     cdsDest.FieldDefs.Clear;
     for i :=0 to cdsSrc.FieldDefs.Count -1 do
     begin
       with cdsDest.FieldDefs.AddFieldDef do
       begin
         Name := cdsSrc.FieldDefs[i].Name;
         DataType := cdsSrc.FieldDefs[i].DataType;
         Size := cdsSrc.FieldDefs[i].Size;
         Precision := cdsSrc.FieldDefs[i].Size;
         Attributes := cdsSrc.FieldDefs[i].Attributes;
         Required := cdsSrc.FieldDefs[i].Required;
       end;
     end;
     cdsDest.CreateDataSet;
     adoU.Connection := lAdoConn;
     adoU.CommandText :='';

     bContinue := true;
     cdsSrc.First;
//     while (not cdsSrc.Eof) and bContinue do
     while (not cdsSrc.Eof) and bContinue and (not bAtHandle) and (not bBtHandle) do
     begin
       cdsDest.Insert;
       for i :=0 to cdsSrc.FieldCount -1 do
         cdsDest.Fields[i].Value := cdsSrc.Fields[i].Value;
{       begin  //2004-4-9 add by vinson zeng for Blob & Int64
         case cdsDest.Fields[i].DataType of
           ftString..ftDateTime:  cdsDest.Fields[i].Value := cdsSrc.Fields[i].Value;
           ftLargeint : cdsDest.Fields[i].AsString := cdsSrc.Fields[i].AsString;
           ftFixedChar, ftWideString: cdsDest.Fields[i].Value := cdsSrc.Fields[i].Value;
           ftBlob, ftMemo, ftGraphic:  cdsDest.Fields[i].Value := cdsSrc.Fields[i].Value;
         end;
       end;    }
      case cdsSrc.UpdateStatus of
      usUnmodified:
           begin
              cdsSrc.Next;
              sSql := ' Update '+sTblName+' Set ';
              s1 := '';
              for j := 0 to cdsSrc.FieldCount -1 do
              begin
                v1 := cdsSrc.Fields[j].Value;
                if not VarIsNull(v1) then
                begin
                  if s1<>'' then s1 := s1 +',';
                  s1 := s1 + cdsSrc.Fields[j].FieldName+ ' = ';
                  s1 := s1 + FieldValueToSqlStr(cdsSrc.Fields[j].DataType,v1);
                end;
              end;
              sSql := sSql +' '+s1 + ' Where ';
              for j := 0 to cdsDest.FieldCount -1 do
              begin
                v1 := cdsDest.Fields[j].Value;
                if j>0 then sSql := sSql +' and ';
                if not VarIsNull(v1) then
                begin
                   sSql := sSql + cdsDest.Fields[j].FieldName+ ' = ';
                   sSql := sSql + FieldValueToSqlStr(cdsDest.Fields[j].DataType,v1);
                   sSql := sSql +' ';
                end
                else
                begin
                   sSql := sSql + cdsDest.Fields[j].FieldName + ' Is Null ';
                end;
             end;

             sSqlSelect := GenSelectDS(sTblName,cdsDest,lFieldKeys);

             UpdateError := ueOk;
             adoSelect := TAdoDataSet.Create(nil);
               try
                 UADebugEx(ddUpdate,Now(),Self,sSqlSelect);
                 adoSelect.Connection := lAdoConn;
                 adoSelect.CommandText := sSqlSelect;
                 adoSelect.Open;
               except
                  on  E:Exception do
                  begin
                    Inc(Result);
                    if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
                    UpdateError := ueSelectSql;
                  end;
               end;

               iOrgCount := adoSelect.RecordCount;

               if UpdateError = ueOk then
               begin
                  if iOrgCount =0 then
                  begin
                    UpDateError := ueModChanged;
                    inc(Result);
                    if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
                  end
                  else if iOrgCount=1 then
                  begin
                    try
                      UADebugEx(ddUpdate,Now(),Self,sSql);
                      adoU.CommandText := sSql;
                      BeforeTriggerForDataSet(sTblName,cdsSrc,cdsDest,bBtHandle);
                      adoU.Execute;
                      AfterTriggerForDataSet(sTblName,cdsSrc,cdsDest,bAtHandle);
                      UpDateError := ueOk;
                    except
                       on E:Exception do
                       begin
                         inc(Result);
                         if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
                         UpDateError := ueModOneSql;
                       end;
                    end;
                  end
                  else
                  begin
                   if upModifyOne in UpdateType then
                   begin
                     Inc(Result);
                     if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
                     UpDateError := ueModOneButMany;
                   end
                   else
                   begin
                     try
                       UADebugEx(ddUpdate,Now(),Self,sSql);
                       adoU.CommandText := sSql;
                       BeforeTriggerForDataSet(sTblName,cdsSrc,cdsDest,bBtHandle); ///???
                       adoU.Execute;
                       AfterTriggerForDataSet(sTblName,cdsSrc,cdsDest,bAtHandle);
                       UpDateError :=ueOk;
                     except
                       on E:Exception do
                       begin
                         Inc(Result);
                         if (iFailMax>0) and (Result >= iFailMax) then bContinue := false;
                         UpdateError := ueModManySql;
                       end;
                     end;
                  end;
               end;
             end;
            if UpdateError <>ueOk then
            begin

               //修改数据不成功，返回调用异常
               //异常消息+数据包
               MakeUAExceptionMsg(UA_E_EXEC_MODIFY_SQL,nil,TUAUpdateErrorMsg[Ord((updateError))] +#13#10+ 'Sql Script Is:' + sSql );
               cdsDest.Append;
               for j :=0 to cdsDest.Fields.Count -1 do
                  cdsDest.Fields[j].Value := adoSelect.fieldByName(cdsDest.Fields[j].FieldName).value;
               cdsDest.Append;
               for j := 0 to cdsDest.Fields.Count -1 do
                 cdsDest.Fields[j].Value := cdsSrc.Fields[j].Value;
                 aErrorCDS.AppendData(cdsDest.Data,false);
              end;
              FreeAndNil(adoSelect);
              cdsDest.first;
              for j := 1 to cdsDest.RecordCount do
                  cdsDest.Delete;
          end;

       usInserted:
       begin
          sSql := 'insert  into '+ sTblName+'(';
          s1 :='';
          for j := 0 to cdsSrc.Fields.Count -1 do
          begin
            v1 :=  cdsSrc.Fields[j].Value;
            if not VarIsNull(v1) then
            begin
              if s1<>'' then
              begin
                sSql := sSql+',';
                s1 := s1 +',';
              end;
            sSql := sSql +cdsSrc.Fields[j].FieldName;
            s1 := s1 + FieldValueToSqlStr(cdsSrc.Fields[j].DataType,v1);
            end;
          end;
          if s1<>'' then
          begin
            sSql := sSql +')';
            s1 := s1 +')';
            sSql := sSql+ '  values   (' +s1;
            sSqlSelect := GenSelectDS(sTblName,cdsDest,lFieldKeys);