uaclientdataset.pas

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

          else begin
           {$ifdef chineseinfo}
            FDataInfo := '当前数据集没有激活！';
           {$else}
            FDataInfo := 'not current dataset active！';
           {$endif}
          end;
        end;
      deParentScroll:
          begin
          end;
      deDataSetChange:
          begin

          end;
      deUpdateState:  //2004-3-10 wait bug fix for ?????
          begin


          end;
    end;
    inherited;
  except
    on E:Exception do
       begin
         Showmessage('Native Error:'+E.Message+#13#10+ 'Event Code Is:'+IntToStr(Ord(Event)));
       end;
  end;

end;

destructor TUAClientDataSet.Destroy;
begin


  FDataSheetList.Free;;
  FRowSheetList.Free;
  FMasterLinkList.Free;
  FFieldsDesigner.Free;

  inherited;

end;



function TUAClientDataSet.GetAliasTableName: string;
begin
  Result := FAliasTableName;
end;

function TUAClientDataSet.GetAllRecCount: Integer;
begin
  Result := FAllRecCount;
end;

function TUAClientDataSet.GetFetchNextDataPacket: Boolean;
begin
  Result := FFetchNextDataPacket;
end;

function TUAClientDataSet.GetCanUpdate: Boolean;
begin
  Result := FCanUpdate;
end;

function TUAClientDataSet.GetKeyFields: string;
begin
  Result := FKeyFields;
end;

function TUAClientDataSet.GetUAServiceClient: TUAServiceClient;
begin
  Result := FUAServiceClient;
end;

procedure TUAClientDataSet.InternalDelete;
begin

  DeleteDetailRecords(Self);
  inherited;

end;


procedure TUAClientDataSet.InternalPost;
begin
  inherited;
end;

procedure TUAClientDataSet.Notification(AComponent: TComponent;
  Operation: TOperation);
begin

  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FUAServiceClient <> nil) and
     (AComponent = UAServiceClient) then UAServiceClient := nil;

end;

procedure TUAClientDataSet.SetAliasTableName(const Value: string);
begin
  if Trim(Value) <> '' then
    FAliasTableName := Value;
end;

procedure TUAClientDataSet.SetAllRecCount(const Value: Integer);
begin
  FAllRecCount := Value;
end;

procedure TUAClientDataSet.SetFetchNextDataPacket(
  const Value: Boolean);
begin
  FFetchNextDataPacket := Value;
end;


procedure TUAClientDataSet.SetKeyFields(const Value: string);
begin
  if Trim(Value) <> '' then
    FKeyFields := Value;
end;

procedure TUAClientDataSet.SetUAServiceClient(
  const Value: TUAServiceClient);
begin

  if Value <> nil then
    FUAServiceClient := Value
  else
    FUAServiceClient := nil;

end;


{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.DoUpdate
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: const UpdateIndex: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TUAClientDataSet.DoUpdate(const UpdateIndex: Integer);
var
  sErrorCode:string;
  bCando:Boolean;
  bDoOnError:Boolean;
  iError:integer;
  iMaxError:integer;

begin

  bCando := false;
  bDoOnError := true;
  iError := 0;
  iMaxError := 0;

  CheckForUpdate;

  Screen.Cursor := crSqlWait;
  try
    if CanUpdate then
    begin
      try
        if Assigned(FBeforeUpdate) then
          FBeforeUpdate(Self);

        if BuildDeltaParam(Self) then
        begin
          iMaxError := MasterUAServiceClient.DoUpdate('SubmitAllDelta',UpdateIndex);   //Normal ServiceName
          if UpdateIndex = -1 then
           Include(FOperateOptions,ooUpdate);

          if UpdateIndex = 1 then
           Include(FOperateOptions,ooUpdateCustom);

          bCando := true;
        end
        else begin
          bCando := false;
          iError := -7;    //Local Error on Add Delta
        end;

        if Assigned(FAfterUpadte) then
          FAfterUpadte(Self);

      except
        on E:Exception do
           begin
             iError := -1; //Remote Process Error on ApplyUpdates
             sErrorCode := '-30002';

             if UpdateIndex = -1 then
               Exclude(FOperateOptions,ooUpdate);

             if UpdateIndex = 1 then
               Exclude(FOperateOptions,ooUpdateCustom);

             Showmessage('data update error!'+#13+'error code is:'+sErrorCode
                          +#13#10+'native error information is:'+E.Message);
           end;
      end;
    end;
  finally
    Screen.Cursor := crDefault;

  end;

  if bCando and (iError = 0) and (MasterUAServiceClient.UAUpdateDataOutPacket.ResultCode = 0) and (iMaxError = 0) then
  begin
    if not CheckOperateState(1) then
 //     iError := -9 // Local Error On MergeData
    else
    begin
      MergeAllChangeLog;
//      MessageDlg('执行远程数据更新成功！', mtInformation,[mbOk], 0);
      Application.MessageBox('执行远程数据更新成功！',PChar(Application.Title),MB_OK);
    end;
  end
  else begin
    if Assigned(FUpdateErrorEvent) then
     FUpdateErrorEvent(Self,iError,bDoOnError);
    if  bDoOnError then
    begin
//      if MessageDlg('执行远程数据更新失败，确认继续当前业务数据编辑工作吗？',mtWarning, [mbYes, mbNo], 0) = mrYes then
      if Application.MessageBox('执行远程数据更新失败，确认继续当前业务数据编辑工作吗？',PChar(Application.Title),
       MB_YESNO) = IDYES then
        Exit
      else
        CancelSubmitAllDelta;
    end
    else begin
      //do nothing in here
    end;
  end;

end;
{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.DoRequest
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: const RequestIndex: Integer
  Result:    OleVariant
-----------------------------------------------------------------------------}


function TUAClientDataSet.DoRequest( const RequestIndex: Integer): OleVariant;
var
  sErrorCode:string;
  iMaxError:integer;
begin

  //Normal ServiceName Is : RequestAllData;
  iMaxError := 0;
  Result := Unassigned;
  Screen.Cursor := crSqlWait;
  try
    try
      case RequestIndex of
        -1 :         //标准数据请求：只记录数据分页键值
        begin
          if BuildRequestDataParam(Self) <> -1 then
          begin
            try
              iMaxError := MasterUAServiceClient.DoRequest('RequestAllData',-1);
              Result := MasterUAServiceClient.UARequestDataOutPacket.UAData;
              Include(FOperateOptions,ooRequest);
            except
              on E:Exception do
                 begin
                   Exclude(FOperateOptions,ooRequest);
                 end;
            end;
          end;
        end;
        1:         //请求下一个数据包：只记录数据分页键值
        begin

          if Assigned(FBeforeRequest) then
            FBeforeRequest(Self);

          if BuildRequestDataParam(Self) <> -1 then
          begin
            try
              iMaxError := MasterUAServiceClient.DoRequest('RequestAllData',1);
              Result := MasterUAServiceClient.UARequestDataOutPacket.UAData;
            except
              on E:Exception do
                 begin
                   Exclude(FOperateOptions,ooRequestNext);
                 end;
            end;
          end;
        end;
        0:         //用户自定义的数据请求：只记录数据集合所有行数据键值
        begin
          if ooQueryData In FOperateOptions then
          begin
            if Assigned(FBeforeRequest) then
              FBeforeRequest(Self);

            if BuildRequestDataParam(Self) <> -1 then
            begin
              try
                iMaxError := MasterUAServiceClient.DoRequest('QueryData',1);
                Result := MasterUAServiceClient.UARequestDataOutPacket.UAData;
              except
                on E:Exception do
                   begin
                   end;
              end;
            end;
          end
          else
          if (ooRefreshAllData In FOperateOptions) or (ooRefreshSelected in FOperateOptions) then
          begin
            if Assigned(FBeforeRequest) then
              FBeforeRequest(Self);

            if BuildRequestDataParam(Self) <> -1 then
            begin
              try
                iMaxError := MasterUAServiceClient.DoRequest('RefreshData',1);
                Result := MasterUAServiceClient.UARequestDataOutPacket.UAData;
              except
                on E:Exception do
                   begin
                   end;
              end;
            end;
          end;
        end;
        else
          MessageDlg('can not support service request!', mtWarning,[mbOk], 0)
      end;

      if Assigned(FAfterRequest) then
        FAfterRequest(Self,Result);

      if (not VarIsEmpty(Result)) and VarIsArray(Result) and
          (VarCompareValue(Result,Unassigned) <> vrEqual) and (iMaxError = 0) then
          AddReturnDataPacket(Result);

    except
      on E:Exception do
         begin
           sErrorCode := '-30001';
           Showmessage('data request error!'+#13+'error code is:'+sErrorCode
                        +#13#10+'native error information is:'+E.Message);
         end;
    end;
  finally
    Screen.Cursor := crDefault;
  end;

end;

function TUAClientDataSet.GetDataSetType: TDataSetType;
var
  lList:TList;
  HaveParent:Boolean;
  HaveDetail:Boolean;
begin

  if (FDataSetType <> dtNone) then
  begin
    Result := FDataSetType;
    Exit;
  end
  else
  begin
    HaveParent := (MasterSource <> nil) and (Trim(MasterFields) <>'');
    lList := TList.Create;
    try
      GetDetailDataSets(lList);
      HaveDetail := lList.Count > 0;
    finally
      if Assigned(lList) then
        lList.Free;
    end;

    if (not HaveParent) and HaveDetail then
      FDataSetType := dtMaster;
    if HaveParent and (not HaveDetail) then
      FDataSetType := dtDetail;
    if (not HaveParent) and (not HaveDetail) then
      FDataSetType := dtSingle;
    if HaveParent and HaveDetail then
      FDataSetType := dtBoth;
    Result := FDataSetType;

  end;

//  Assert(FDataSetType = dtNone,'can not get UAClientDataSet DataSetType!');

end;


procedure TUAClientDataSet.ClearAllParams;
begin
  FDataSheetList.Clear;
  FRowSheetList.Clear;
  FMasterLinkList.Clear;
end;


procedure TUAClientDataSet.CheckDetailRecords;
var
  i,RecCount:integer;
  lList:TList;
  aMasterLink:TMasterLinkParam;
  aMasterDataSet:TDataSet;
  Status: DBResult;
begin


  Status := DSCursor.GetRecordCount(RecCount);
  aMasterDataSet := MasterSource.DataSet;

  if DataSetField <> nil then
  begin

  end
  else begin
    if (RecCount = 0) and
       (PacketRecords = 0) and not aMasterDataSet.IsEmpty and
       (aMasterDataSet.State <> dsInsert) and (TUAClientDataSet(aMasterDataSet).ChangeCount = 0) then
    begin
      lList := TList.Create;
      FMasterLinkList.Clear;
      try
        try