uaclientdataset.pas

基于Midas 技术的多层应用开发包

  Result:    integer
-----------------------------------------------------------------------------}



function TUAClientDataSet.BuildRequestDataParam(Sender: TObject): integer;
var
  aDataRequestParam:TDataRequestParam;
  i:integer;
  aDataSheetParam:TDataSheetParam;
  aMasterLinkParam:TMasterLinkParam;
  aRowSheetParam:TRowSheetParam;
begin

  with MasterUAServiceClient do
  begin
    aDataRequestParam := TDataRequestParam.Create;
    try
      try

        ClearRequestParams;
        aDataRequestParam.AliasTableName := AliasTableName;
        aDataRequestParam.KeyFields := KeyFields;
        aDataRequestParam.RequestRecCount := PacketRecords;
        aDataRequestParam.SqlParams := SqlScript;

        if Active then
          aDataRequestParam.CurrRecCount := RecordCount;

        if FMasterLinkList.Count <> 0 then
        begin
          for i := 0 to FMasterLinkList.Count -1 do
          begin
            aMasterLinkParam := TMasterLinkParam.Create;
            aMasterLinkParam.UAData := TMasterLinkParam(FMasterLinkList.Items[i]).UAData;
            UARequestDataInPacket.AddItemMasterLink(aMasterLinkParam);
          end;
        end;

        if FRowSheetList.Count <> 0 then
        begin
          for i := 0 to FRowSheetList.Count -1 do
          begin
            aRowSheetParam := TRowSheetParam.Create;
            aRowSheetParam.UAData := TRowSheetParam(FRowSheetList.Items[i]).UAData;
            UARequestDataInPacket.AddItemRowSheet(aRowSheetParam);
          end;
        end;

        if (ooRequestNext in FOperateOptions) and  (FDataSheetList.Count <> 0) then
        begin
          for i := 0 to FDataSheetList.Count -1 do
          begin
            aDataSheetParam := TDataSheetParam.Create;
            aDataSheetParam.UAData := TDataSheetParam(FDataSheetList.Items[i]).UAData;
            UARequestDataInPacket.AddItemDataSheet(aDataSheetParam);
          end;
        end;

      except
        Result := -1;
      end;
     UARequestDataInPacket.AddItemRequestData(aDataRequestParam);
     Result := 1;
    finally

    end;
  end;

end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.AddReturnDataPacket
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: const vData: OleVariant
  Result:    None
-----------------------------------------------------------------------------}

procedure TUAClientDataSet.AddReturnDataPacket(const vData: OleVariant);
var
  UAReturnPacket:TUARequestDataOutPacket;
  rData:OleVariant;
  aReturnData:TDataReturnParam;
  aDataSheet:TDataSheetParam;
  aRowSheet:TRowSheetParam;
  i:integer;
  aCds:TClientDataSet;
  bFindRec,bCanAppend:Boolean;
//  sKeys:string;
//  vLocateValue:Variant;
  iOldRecCount:integer;
  iOpenRecCount:integer;
begin


 //2004-03-05  bug fix for record cursor point error

 iOldRecCount := RecordCount; //2004-03-05 记录当前记录计数

 bFindRec := false;
 bCanAppend := false;
 if not Assigned(MasterUAServiceClient) then Exit;

 UAReturnPacket := TUARequestDataOutPacket.Create;

 try

   UAReturnPacket.UAData := MasterUAServiceClient.UARequestDataOutPacket.UAData;
   aReturnData := UAReturnPacket.GetItemReturnData(0);

   if Assigned(aReturnData) and (not VarIsEmpty(aReturnData.UAData)) and
     (VarIsArray(aReturnData.UAData)) and (not (VarCompareValue(aReturnData.UAData,Unassigned) = vrEqual)) then
   begin
     rData := aReturnData.Data;
     AllRecCount := aReturnData.AllRecCount;
     iOpenRecCount := aReturnData.CurrRecCount - iOldRecCount; // 2004-03-05 fix by vinson zeng for location curren record
   end;

   if UAReturnPacket.CountRowSheet <> 0 then       //duplicate check
   begin
     for i := 0 to UAReturnPacket.CountRowSheet - 1 do
     begin
       aRowSheet := TRowSheetParam.Create;
       aRowSheet.UAData:= UAReturnPacket.GetItemRowSheet(i).UAData;
       FRowSheetList.Add(aRowSheet);
     end;
   end;

   if UAReturnPacket.CountDataSheet <> 0 then
   begin
     if not (ooQueryData in FOperateOptions) then
     begin
       FDataSheetList.Clear;
       for i := 0 to UAReturnPacket.CountDataSheet -1 do
       begin
         aDataSheet := TDataSheetParam.Create;
         aDataSheet.UAData := UAReturnPacket.GetItemDataSheet(i).UAData;
         FDataSheetList.Add(aDataSheet);
       end;
     end
     else
     begin
       if FDataSheetList.Count = 1 then      // begin process
       begin

       end;
     end;
   end;

   if CheckOperateState(-1) then
   begin
     if ooQueryData in FOperateOptions then
     begin
       DisableControls;         //duplicate key value process
       CloseAutoRequestNext(true);
       aCds := TClientDataSet.Create(nil);
       try
         aCds.Data := rData;
         if not aCds.Active then
           aCds.Open;
         aCds.First;
         try
           while not aCds.Eof do
           begin
             if Pos(',',KeyFields) <> 0 then
             begin
//               raise Exception.Create('UA SDK not support data type'!);
               //Multi PrimaryKey not Support
               //2004-03-05 fix Multi Key Locate

             end
             else begin
               bFindRec := Self.Locate(KeyFields, aCds.FindField(KeyFields).Value, [loPartialKey]);
             end;
             if bFindRec then
             begin
               Self.Delete;
               Self.MergeChangeLog;
             end
             else
               aCds.Next;
           end;
           bCanAppend := true;
         except
           on E:Exception do
              begin
                bCanAppend := false;
                Showmessage('query data error!'+#13#10+ 'native error information is:'+E.Message);
              end;
         end;
       finally
         if bCanAppend then
         begin
           VarClear(rData);
           rData := aCds.Data;
         end;
         if aCds.RecordCount = 0 then
         begin // modify by vinson zeng on 2004-01-02
           if FConfirmNotFound then  // modify by vinson zeng on 2004-01-05
          //   MessageDlg('系统不存在与查询条件相匹配的记录，请确认！', mtInformation,[mbOk], 0);
             Application.MessageBox('系统不存在与查询条件相匹配的记录，请确认！',PChar(Application.Title),MB_OK);

         end;

         if Assigned(aCds) then
           FreeAndNil(aCds);
         CloseAutoRequestNext(false);
         EnableControls;
       end;
     end;
     if ooRefreshAllData in FOperateOptions then
     begin
       CloseAutoRequestNext(true);
       DisableControls;
       try
         try
           EmptyDataSet;
           MergeChangeLog;
         except

         end;
       finally
         CloseAutoRequestNext(false);
         EnableControls;
       end;
     end;
     if ooRefreshSelected in FOperateOptions then
     begin
       CloseAutoRequestNext(true);
       DisableControls;
       try
         try
           Delete;
           MergeChangeLog;
         except
         end;
       finally
         CloseAutoRequestNext(false);
         EnableControls;
       end;
     end;

     if (not VarIsNull(rData)) and (not VarIsEmpty(rData)) then
     begin   // modify by vinson zeng on 2004-01-02
       AppendData(rData,false);
       MergeChangeLog;
     end;

     // 2004-03-05 fix by vinson zeng not Sing
       DisableControls;
       CloseAutoRequestNext(true);

      if ooQueryData in FOperateOptions then
         MoveBy(iOldRecCount + 1); // Rec Position OffSet Is 1
      if ooRefreshAllData in FOperateOptions then
         First;
      if ooRefreshSelected in FOperateOptions then
         Last;

       CloseAutoRequestNext(false);
       EnableControls;

   end;

 finally
   if Assigned(UAReturnPacket) then
     FreeAndNil(UAReturnPacket);
 end;

end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.RefreshAllData
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: Sender: TObject; const bAll :Boolean = false
  Result:    None
-----------------------------------------------------------------------------}

procedure TUAClientDataSet.RefreshAllData(Sender: TObject; const bAll :Boolean = false);
var
  sTmp:string;
begin

 // bug fix by vinson zeng at 2003-11-03
 if (RecordCount = 0 ) or (State = dsInactive) then
 begin
   {$ifdef CHNDEBUG}
//   MessageDlg('不能执行此项操作，因为数据集没有激活或者记录为空！', mtWarning,[mbOk], 0);
   Application.MessageBox('不能执行此项操作，因为数据集没有激活或者记录为空！',PChar(Application.Title),MB_OK);
   {$else}
   MessageDlg('can not do operation，bacause not dataset active or dataset is empty!', mtWarning,[mbOk], 0);
   {$endif}
   Exit;
 end;

 if bAll then
  Include(FOperateOptions,ooRefreshAllData)
 else
  Include(FOperateOptions,ooRefreshSelected);

 try
   if BuildRefreshDataScript(Sender,sTmp,bAll) then
   begin
     if Trim(sTmp) <> '' then
     begin
       try
         SqlScript := '';
         SqlScript := sTmp;
         DoRequest(0);
         SqlScript := '';
       except
       end;
     end;
   end;
 finally
   if bAll then
    Exclude(FOperateOptions,ooRefreshAllData)
   else
    Exclude(FOperateOptions,ooRefreshSelected);
 end;

end;

procedure TUAClientDataSet.SetOpenAllData(const Value: Boolean);
begin
  if ( csDesigning in ComponentState  )then
    Exit;
  FOpenAllData := Value;

  if FOpenAllData  then
    DoRequest
  else
  begin
    // do other thing in here ,maybe close all uaclientdataset
  end;

end;


procedure TUAClientDataSet.InternalCancel;
begin
  inherited;
end;

procedure TUAClientDataSet.DoOnNewRecord;
begin
  inherited;

end;

function TUAClientDataSet.GetDataInfo: string;
begin
  Result := FDataInfo;
end;

procedure TUAClientDataSet.CloseAutoRequestNext(const bClose:Boolean = true);
begin

  if bClose then
    Exclude(FUAOptions,uoAutoRequestNext)
  else
    Include(FUAOptions,uoAutoRequestNext);
    
end;

procedure TUAClientDataSet.QueryData(Sender: TObject;const ClearData:Boolean = false);
begin

  Include(FOperateOptions,ooQueryData);
  try
    try
      if ClearData then
        ClearAllData;
      DoRequest(0);
    except
    end;
  finally
    Exclude(FOperateOptions,ooQueryData);
  end;

end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.BuildRefreshDataScript
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: Sender: TObject;var sSqlScript:string;const bAll :Boolean = false
  Result:    Boolean
-----------------------------------------------------------------------------}

function TUAClientDataSet.BuildRefreshDataScript(Sender: TObject;var sSqlScript:string;const bAll :Boolean = false):Boolean;
var
  WhereClause,sTmp,s2:string;
  lList:TStringList;
  i:integer;
  lField:TField;
  SavePlace: TBookmark;

begin

//  Result := false;
  DisableControls;
  CloseAutoRequestNext(true);
  lList := TStringList.Create;
  try
    try
      SavePlace := GetBookmark;
      if bAll then
      begin
        First;
        while not Eof do
        begin
          if Trim(sSqlScript) <> '' then sSqlScript := sSqlScript + ' or ';
          WhereClause := '';
          xStrSplit(KeyFields,[','],lList,true,true);
          for i := 0 to lList.Count -1 do
          begin
            sTmp := '';
            if Trim(WhereClause) <> '' then WhereClause := WhereClause + ' and ';
            lField := FindField(lList.Strings[i]);
            sTmp := ' ('+ lField.FieldName + ' =';
            if Assigned(lField) then
            begin
              if lField.DataType in [ftString, ftWideString] then
                sTmp := sTmp +  #39 + lField.AsString + #39 + ' )'
              else
              if lField.DataType in [ftDate,ftDateTime] then
              begin
                sTmp := sTmp + DateToStr(lField.AsDateTime) +' )';
              end
              else
                sTmp := sTmp + VarToStr(lField.Value) +' )';