dbclient.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

  if Options = [foDetails] then
    DataEvent(deDataSetChange, 0);
end;

procedure TCustomClientDataSet.FetchBlobs;
begin
  InternalFetch([foBlobs]);
end;

procedure TCustomClientDataSet.FetchDetails;
begin
  InternalFetch([foDetails]);
end;

procedure TCustomClientDataSet.RefreshRecord;
begin
  InternalFetch([foRecord]);
  Resync([]);
end;

procedure TCustomClientDataSet.CheckProviderEOF;
begin
  if HasAppServer and not ProviderEOF and FFetchOnDemand and (FPacketRecords <> 0) then
    FetchMoreData(True);
end;

procedure TCustomClientDataSet.AddDataPacket(const Data: OleVariant; HitEOF: Boolean);
begin
  Check(FDSBase.AppendData(VarToDataPacket(Data), HitEOF));
end;

procedure TCustomClientDataSet.AppendData(const Data: OleVariant; HitEOF: Boolean);
begin
  if not Active then
  begin
    Self.Data := Data;
    if not HitEOF then
      FDSBase.SetProp(dspropDSISPARTIAL, Integer(False));
  end else
  begin
    AddDataPacket(Data, HitEOF);
    if State <> dsBrowse then Exit;
    if IsEmpty then First else
    begin
      UpdateCursorPos;
      Resync([]);
    end;
  end;
end;

function TCustomClientDataSet.GetNextPacket: Integer;
begin
  CheckActive;
  if ProviderEOF then Result := 0 else
  begin
    UpdateCursorPos;
    if (FPacketRecords = 0) and FMasterLink.Active and
       (FMasterLink.Fields.Count > 0) then CheckDetailRecords else
    begin
      AddDataPacket(DoGetRecords(FPacketRecords, Result, 0, '', Unassigned),
        Result <> FPacketRecords);
      ProviderEOF := Result <> FPacketRecords;
    end;
    Resync([]);
  end;
end;

procedure TCustomClientDataSet.SetProviderName(const Value: string);
begin
  if Value = FProviderName then Exit;
  if (Value <> '') then
  begin
    CheckInactive;
    ClearSavedPacket;
  end;
  FAppServer := nil;
  FProviderName := Value;
end;

procedure TCustomClientDataSet.SetProvider(Provider: TComponent);
begin
  if Provider is TCustomProvider then
    AppServer := TLocalAppServer.Create(TCustomProvider(Provider)) else
  if Provider is TDataset then
    AppServer := TLocalAppServer.Create(TDataset(Provider)) else
    AppServer := nil;
end;

function TCustomClientDataSet.GetAppServer: IAppServer;
var
  ProvComp: TComponent;
  DS: TObject;
begin
  if not HasAppServer then
  begin
    if ProviderName <> '' then
      if Assigned(RemoteServer) then
        FAppServer := RemoteServer.GetServer else
      if Assigned(ConnectionBroker) then
        FAppServer := ConnectionBroker.GetServer else
      begin
        if Assigned(Owner) then
        begin
          ProvComp := Owner.FindComponent(ProviderName);
          if Assigned(ProvComp) and (ProvComp is TCustomProvider) then
          begin
            DS := GetObjectProperty(ProvComp, 'DataSet');
            if Assigned(DS) and (DS = Self) then
              DatabaseError(SNoCircularReference, Self);
            FAppServer := TLocalAppServer.Create(TCustomProvider(ProvComp));
          end;
        end;
      end;
    if not HasAppServer then
      DatabaseError(SNoDataProvider, Self);
  end;
  Result := FAppServer;
end;


function TCustomClientDataSet.GetHasAppServer: Boolean;
begin
  Result := Assigned(FAppServer);
end;


procedure TCustomClientDataSet.SetAppServer(Value: IAppServer);
begin
  FAppServer := Value;
  if Assigned(Value) then
    ClearSavedPacket;
end;

procedure TCustomClientDataSet.SetProviderEOF(Value: Boolean);
begin
  FProviderEOF := Value;
  if Assigned(FCloneSource) then
    FCloneSource.ProviderEOF := Value;
end;

function TCustomClientDataSet.GetProviderEOF: Boolean;
begin
  if Assigned(FCloneSource) then
    FProviderEOF := FCloneSource.ProviderEOF;
  Result := FProviderEOF;
end;

function TCustomClientDataSet.GetRemoteServer: TCustomRemoteServer;
begin
  Result := FRemoteServer;
end;

procedure TCustomClientDataSet.SetRemoteServer(Value: TCustomRemoteServer);
begin
  if Value = FRemoteServer then Exit;
  if Assigned(Value) and Assigned(ConnectionBroker) then
    SetConnectionBroker(Nil);
  AppServer := nil;
  if Assigned(FRemoteServer) then FRemoteServer.UnRegisterClient(Self);
  FRemoteServer := Value;
  if Assigned(Value) then
  begin
    CheckInactive;
    Value.RegisterClient(Self);
    ClearSavedPacket;
    Value.FreeNotification(Self);
  end;
  FRemoteServer := Value;
end;

procedure TCustomClientDataSet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = RemoteServer) then
    RemoteServer := nil;
  if (Operation = opRemove) and (AComponent = FCloneSource) then
  begin
    FProviderEOF := FCloneSource.ProviderEOF;
    FCloneSource := nil;
  end;
  if (Operation = opRemove) and (AComponent = FConnectionBroker) then
    FConnectionBroker:= nil;
end;

procedure TCustomClientDataSet.DataEvent(Event: TDataEvent; Info: Integer);
begin
  case Event of
    deParentScroll: MasterChanged(Self);
    deDataSetScroll,
    deDataSetChange: SetAltRecBuffers(nil, nil, nil);
    deFieldListChange: FAggFieldsInit := False;
    deConnectChange:
      if not LongBool(Info) then
        AppServer := nil;
  end;
  inherited;
end;

function TCustomClientDataSet.GetDelta: OleVariant;
var
  FDeltaDS: IDSBase;
  TempPacket: TDataPacket;
begin
  CheckBrowseMode;
  Check(FDSBase.GetDelta(FDeltaDS));
  FreeDataPacket(FDeltaPacket);
  Check(FDeltaDS.StreamDS(FDeltaPacket));
  SafeArrayCheck(SafeArrayCopy(FDeltaPacket, TempPacket));
  DataPacketToVariant(TempPacket, Result);
end;

procedure TCustomClientDataSet.Execute;
begin
  DoExecute(PackageParams(Params));
end;

function TCustomClientDataSet.DataRequest(Data: OleVariant): OleVariant;
begin
  Result := AppServer.AS_DataRequest(ProviderName, Data);
end;

function TCustomClientDataSet.ApplyUpdates(MaxErrors: Integer): Integer;
var
  RootDataset: TCustomClientDataset;
begin
  CheckBrowseMode;
  RootDataset := Self;
  while RootDataset.FParentDataSet <> nil do
    RootDataset := RootDataset.FParentDataset;
  with RootDataset do
    if ChangeCount = 0 then
      Result := 0 else
      Reconcile(DoApplyUpdates(Delta, MaxErrors, Result));
end;

procedure TCustomClientDataSet.MergeChangeLog;
begin
  CheckBrowseMode;
  FDSBase.AcceptChanges;
  UpdateCursorPos;
  Resync([]);
end;

procedure TCustomClientDataSet.SetAltRecBuffers(Old, New, Cur: PChar);
begin
  FOldValueBuffer := Old;
  FNewValueBuffer := New;
  FCurValueBuffer := Cur;
end;

function TCustomClientDataSet.ReconcileCallback(
    iRslt         : Integer;   { Previous error if any }
    iUpdateKind   : DSAttr;    { Update request Insert/Modify/Delete }
    iResAction    : dsCBRType; { Resolver response }
    iErrCode      : Integer;   { Native error-code, (BDE or ..) }
    pErrMessage,               { Native errormessage, if any (otherwise Null) }
    pErrContext   : PChar;     { 1-level error context, if any (otherwise Null) }
    pRecUpd,                   { Record that failed update }
    pRecOrg,                   { Original record, if any }
    pRecConflict  : Pointer;   { Conflicting error, if any }
    iLevels       : Integer;   { Number of levels to error0level }
    piFieldIDs    : PInteger   { Array of fieldIDS to navigate to error-dataset }
): dsCBRType;
var
  I: Integer;
  Action: TReconcileAction;
  UpdateKind: TUpdateKind;
  DataSet: TCustomClientDataSet;
  E: EReconcileError;
  ReconcileInfo: TReconcileInfo;
begin
  FInReconcileCallback := True;
  try
    if iUpdateKind = dsRecDeleted then
      UpdateKind := ukDelete
    else if iUpdateKind = dsRecNew then
      UpdateKind := ukInsert
    else
      UpdateKind := ukModify;
    if iResAction = dscbrSkip then
      Action := raSkip else
      Action := raAbort;
    FReconcileDataSet.First;
    E := EReconcileError.Create(pErrMessage, pErrContext, iErrCode, iRslt);
    try
      DataSet := FReconcileDataSet;
      for I := 1 to iLevels do
      begin
         DataSet := TCustomClientDataSet((DataSet.Fields.FieldByNumber(piFieldIDs^) as TDataSetField).NestedDataSet);
         inc(piFieldIDs);
      end;
      if UpdateKind = ukDelete then
        DataSet.SetAltRecBuffers(pRecUpd, pRecOrg, pRecConflict) else
        DataSet.SetAltRecBuffers(pRecOrg, pRecUpd, pRecConflict);
      ReconcileInfo.DataSet := Dataset;
      ReconcileInfo.UpdateKind := UpdateKind;
      ReconcileInfo.ReconcileError := E;
      ReconcileInfo.ActionRef := @Action;
      DataEvent(deReconcileError, Integer(@ReconcileInfo));
      if Assigned(FOnReconcileError) then
        FOnReconcileError(DataSet, E, UpdateKind, Action);
    finally
      E.Free;
    end;
  except
    if Assigned(Classes.ApplicationHandleException) then
      ApplicationHandleException(Self);
    Action := raAbort;
  end;
  Result := Ord(Action) + 1;
  FInReconcileCallback := False;
end;

function TCustomClientDataSet.Reconcile(const Results: OleVariant): Boolean;
var
  RCB: Pointer;
  I: Integer;
  AField: TField;
begin
  if VarIsNull(Results) then MergeChangeLog else
  begin
    UpdateCursorPos;
    RCB := @TCustomClientDataSet.ReconcileCallback;
    FReconcileDataSet := TCustomClientDataSet.Create(Self);
    try
      Check(FDSBase.Clone(0, True, False, FReconcileDataSet.FDSBase));
      FReconcileDataSet.ObjectView := True;
      FReconcileDataSet.Open;
      for I := 0 to FReconcileDataSet.FieldCount - 1 do
      begin
        AField := Self.FindField(FReconcileDataSet.Fields[I].FieldName);
        if Assigned(AField) then
          FReconcileDataSet.Fields[I].DisplayLabel := AField.DisplayLabel;
      end;
      Check(FDSBase.Reconcile_MD(FReconcileDataSet.FDSBase, FDeltaPacket,
        VarToDataPacket(Results), Integer(Self), RCB));
    finally
      FReconcileDataSet.Free;
      FReconcileDataSet := nil;
    end;
    Resync([]);
  end;
  Result := (ChangeCount = 0);
end;

procedure TCustomClientDataSet.NotifyCallback;
begin
  try
    if State = dsBrowse then
    begin
      UpdateCursorPos;
      Resync([]);
      UpdateCursorPos;
    end;
  except
  end;
end;

procedure TCustomClientDataSet.SetNotifyCallback;
begin
  if not FNotifyCallback then
  begin
    Check(FDSCursor.SetNotifyCallBack(Integer(Self), @TCustomClientDataSet.NotifyCallback));
    FNotifyCallback := True;
  end;
end;

procedure TCustomClientDataSet.CloneCursor(Source: TCustomClientDataSet; Reset, KeepSettings: Boolean);
begin
  Source.CheckActive;
  Close;
  FDSBase := Source.DSBase;
  Source.UpdateCursorPos;
  FCloneSource := Source;
  FParentDataSet := Source.FParentDataSet;
  if Reset then
  begin
    Filtered := False;
    Filter := '';
    OnFilterRecord := nil;