uaclientdataset.pas

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

            end;
           if Trim(sTmp) <> '' then
             WhereClause := WhereClause + sTmp;
          end;

          if Trim(WhereClause) <> '' then
          begin
            s2 := GetMasterLinkScript(Self);
            if Trim(s2) <> '' then
              WhereClause := ' ('+  WhereClause +' and '+ s2 +' )'
            else
              WhereClause := ' ('+  WhereClause +' )';
          end;
          sSqlScript := sSqlScript + WhereClause ;
         Next;
        end;
      end;

      if not bAll then          //如果是子表刷新
      begin
        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) +' )';
          end;
         if Trim(sTmp) <> '' then
           WhereClause := WhereClause + sTmp;
        end;

        if Trim(WhereClause) <> '' then
        begin
          s2 := GetMasterLinkScript(Self);
          if Trim(s2) <> '' then
            WhereClause := ' ('+  WhereClause +' and '+ s2 +' )'
          else
            WhereClause := ' ('+  WhereClause +' )';
        end;
       sSqlScript := sSqlScript + WhereClause ;
      end;
      Result := true;
    except
      on E:Exception do
         begin
           Result := false;
         end;
    end;
  finally
    if Assigned(lList) then
      FreeAndNil(lList);
    GotoBookmark(SavePlace);
    FreeBookmark(SavePlace);
    EnableControls;
    CloseAutoRequestNext(false);
  end;
  
end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.GetMasterLinkScript
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: Sender: TObject
  Result:    string
-----------------------------------------------------------------------------}

function TUAClientDataSet.GetMasterLinkScript(Sender: TObject): string;
var
  i:integer;
  lList:TList;
  aMasterDataSet:TDataSet;
  MasterClause,s1:string;
begin

  if (DataSetType = dtDetail) or (DataSetType = dtBoth) then
  begin
    aMasterDataSet := MasterSource.DataSet;
    if Assigned(aMasterDataSet) then
    begin
      if DataSetField <> nil then
      begin

      end
      else
      begin
        lList := TList.Create;
        FMasterLinkList.Clear;
        try
          try
            aMasterDataSet.GetFieldList(lList,MasterFields);
            for i := 0 to lList.Count -1 do
            begin
              with TField(lList.Items[i]) do
              begin
                if Trim(MasterClause) <> '' then MasterClause := MasterClause + ' and ';
                if VarIsNull(Value) then
                begin
                  s1 := ' ('+MasterClause + IndexFields[I].FieldName + ' Is Null'+' )';
                  Continue;
                end
                else
                  s1 := ' ('+ IndexFields[I].FieldName +' =';
                if IndexFields[I].DataType in [ftString,ftWideString] then
                begin
                   s1 := s1 + #39 + VarToStr(Value) + #39 +' )'
                end
                else
                if IndexFields[I].DataType in [ftDate,ftDateTime] then
                begin
                  s1 := s1 + DateToStr(VarToDateTime(Value)) +' )'
                end
                else
                  s1 := s1 + VarToStr(Value) +' )'
              end;
              MasterClause := MasterClause +s1;
            end;
            if Trim(MasterClause) <> '' then
             MasterClause := '( '+ MasterClause +' )';
          except
          end;
        finally
          if Assigned(lList) then
            FreeAndNil(lList);
          if Trim(MasterClause) <> '' then
            Result := MasterClause;
        end;
      end;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.DeleteDetailRecords
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: MasterDataSet:TUAClientDataSet
  Result:    None
-----------------------------------------------------------------------------}


procedure TUAClientDataSet.DeleteDetailRecords(MasterDataSet:TUAClientDataSet);
var
  lList:TList;
  i:integer;
  lCds:TUAClientDataSet;
          procedure DeleteAllSubDetailRecords(lDetail:TUAClientDataSet);
          var
            lSubDetail:TUAClientDataSet;
            j:integer;
            lList1:TList;
          begin
            lList1 := TList.Create;
            try
              with lDetail do
              begin
                case DataSetType of
                  dtDetail:
                    begin
                      DisableControls;
                      CloseAutoRequestNext(true);
                      First;
                      while not Eof do Delete;
                      CloseAutoRequestNext(false);
                      EnableControls;
                    end;
                  dtBoth:
                    begin
                      GetDetailDataSets(lList1);
                      for j := 0 to lList1.Count -1 do
                      begin
                        lSubDetail := TUAClientDataSet(lList1.Items[j]);
                        DeleteAllSubDetailRecords(lSubDetail);
                      end;
                      DisableControls;
                      CloseAutoRequestNext(true);
                      First;
                      while not Eof do Delete;
                      CloseAutoRequestNext(false);
                      EnableControls;
                    end;
                end;
              end;
            finally
              if Assigned(lList1) then
                FreeAndNil(lList1);
            end;
          end;
begin

// must fix bug 
  if not Assigned(MasterDataSet) then Exit;
  if not MasterDataSet.Active then Exit;
  if MasterDataSet.RecordCount = 0 then Exit;

  lList := TList.Create;
  try
    try
      MasterDataSet.GetDetailDataSets(lList);
      for i := 0 to lList.Count -1 do
      begin
       lCds := TUAClientDataSet(lList.Items[i]);
       with lCds do
       begin
         case DataSetType of
           dtDetail:
             begin
               DisableControls;
               CloseAutoRequestNext(true);
               First;
               while not Eof do Delete;
               CloseAutoRequestNext(false);
               EnableControls;
             end;
           dtBoth:
               DeleteAllSubDetailRecords(lCds);
         end;
       end;
      end;
    except
      on E:Exception do
         begin
           Showmessage('Delete Detail Records Effect Error;Native Msg:'+E.Message);
         end;
    end;
  finally
    if Assigned(lList) then
      FreeAndNil(lList);
  end;

end;


function TUAClientDataSet.GetConfirmNotFound: Boolean;
begin
  Result := FConfirmNotFound;
end;

procedure TUAClientDataSet.SetConfirmNotFound(const Value: Boolean);
begin
  FConfirmNotFound := Value;
end;

function TUAClientDataSet.GetIndexFields(DataSet: TDataSet): string;
var
  i:integer;
  sTmp:string;
begin

  for i := 0 to IndexFieldCount -1 do
  begin
    if trim(sTmp) <> '' then sTmp := sTmp + ',';
    sTmp := sTmp + IndexFields[i].FieldName;
  end;

  if trim(sTmp) <> '' then
    Result := ','+sTmp;

end;


{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.ClearAllData
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}


procedure TUAClientDataSet.ClearAllData;
var
  lList:TList;
  i:integer;
  sErrorCode:string;
      procedure ClearDetailData(aDetail:TUAClientDataSet);
      var
        j:integer;
        lList1:TList;
      begin
        with aDetail do
        begin
          EmptyDataSet;
          ClearAllParams; //2004-03-13  add by vinson zeng
          MergeChangeLog;
          lList1 := TList.Create;
          GetDetailDataSets(lList1);
          try
            for j := 0 to lList1.Count -1 do
              ClearDetailData(TUAClientDataSet(lList1.Items[j]));
          finally
            if Assigned(lList1) then
             FreeAndNil(lList1);
          end;
        end;
      end;
begin

  lList := TList.Create;
  try
    try
      case GetDataSetType of
         dtDetail,dtSingle:
          begin
            EmptyDataSet;
            ClearAllParams; //2004-03-13  add by vinson zeng
            MergeChangeLog;
          end;
         dtMaster,dtBoth:
          begin
            EmptyDataSet;
            ClearAllParams; //2004-03-13  add by vinson zeng
            MergeChangeLog;
            GetDetailDataSets(lList);
            for i := 0 to lList.Count -1 do
              ClearDetailData(TUAClientDataSet(lList.Items[i]));
          end;
      end;
    except
      on E:Exception do
         begin
           sErrorCode := '-40001';
           Showmessage('clear data error!'+#13+'error code is:'+sErrorCode
                        +#13#10+'native error information is:'+E.Message);
         end;
    end;
  finally
    if Assigned(lList) then
    FreeAndNil(lList);
  end;

end;

procedure TUAClientDataSet.SetUAAutoRequestNext(const Value: Boolean);
begin
  FUAAutoRequestNext := Value;
end;

procedure TUAClientDataSet.SetDesignActive(const Value: Boolean);
begin

  if ( csDesigning in ComponentState  )then
  begin
    if Value <> FDesignActive then
    begin
      FDesignActive := Value;
      if FDesignActive  then
      begin
        if  FieldDefs.Count = 0 then
           DoDesignActive;
      end
      else begin
        if FieldDefs.Count <> 0 then
        begin
          Close;
          FieldDefs.Clear;
        end;
      end;
    end;
  end;

end;

procedure TUAClientDataSet.DoDesignActive;
var
  aTmpSrvCli:TUAServiceClient;
  vOut:OleVariant;
  aTmpFieldDefs:TFieldDefs;
  aTmpCDS:TClientDataSet;
  i:integer;
begin

  aTmpCDS := TClientDataSet.Create(nil);
  aTmpSrvCli := GetMasterUAServiceClient ;
  try
    try
       aTmpSrvCli.UAServiceAdapter.Request('srvobjdesign','requesttblstrus',AliasTableName+'-'+aTmpSrvCli.UAServiceAdapter.DefaultDBName,vOut);
       if (not VarIsEmpty(vOut)) and (VarCompareValue(vOut,Unassigned)<>vrEqual) then

       aTmpCDS.Data := vOut;
       Close;
       if FieldDefs.Count = 0 then
       begin
         FieldDefs.Clear;
         for i := 0 to aTmpCDS.FieldDefs.Count -1 do
         begin
           with FieldDefs.AddFieldDef do
           begin
             Name := aTmpCDS.FieldDefs[i].Name;
             DataType := aTmpCDS.FieldDefs[i].DataType;
             Size := aTmpCDS.FieldDefs[i].Size;
             Precision := aTmpCDS.FieldDefs[i].Size;
             Attributes := aTmpCDS.FieldDefs[i].Attributes;
             Required := aTmpCDS.FieldDefs[i].Required;
             DisplayName := aTmpCDS.FieldDefs[i].DisplayName;
           end;
         end;
       end
       else
       begin
         for i := 0 to aTmpCDS.FieldDefs.Count -1 do
         begin
           if FieldDefs.Find(aTmpCDS.FieldDefs.Items[i].Name) = nil then
           begin
             with FieldDefs.AddFieldDef do
             begin
               Name := aTmpCDS.FieldDefs[i].Name;
               DataType := aTmpCDS.FieldDefs[i].DataType;
               Size := aTmpCDS.FieldDefs[i].Size;
               Precision := aTmpCDS.FieldDefs[i].Size;
               Attributes := aTmpCDS.FieldDefs[i].Attributes;
               Required := aTmpCDS.FieldDefs[i].Required;
               DisplayName := aTmpCDS.FieldDefs[i].DisplayName;
             end;
           end;
         end;
       end;
       CreateDataSet;
    except
      on E:Exception do
         begin
           MessageDlg('maybe a incorrect aliastablename or not exist uaserver!', mtError,[mbOk