dbclient.pas

这是不可多得的源代码

begin
  DoBeforeGetParams(OwnerData);
  UnpackParams(AppServer.AS_GetParams(ProviderName, OwnerData), Params);
  DoAfterGetParams(OwnerData);
end;

procedure TCustomClientDataSet.Check(Status: DBResult);
var
  ErrMsg: array[0..2048] of Char;
begin
  if Status <> 0 then
  begin
    FDSBase.GetErrorString(Status, ErrMsg);
    raise EDBClient.Create(ErrMsg, Status);
  end;
end;

procedure TCustomClientDataSet.CloseCursor;
var
  Params: OleVariant;
  RecsOut: Integer;
  Options: TGetRecordOptions;
  ChangesMade: LongBool;
begin
  ChangesMade := True;
  if Assigned(FDSBase) then
    FDSBase.GetProp(dspropDATAHASCHANGED, @ChangesMade);
  if (FileName <> '') and ChangesMade and not (csDesigning in ComponentState) then
    SaveToFile(FileName);
  inherited CloseCursor;
  if HasAppServer then
  begin
    if not (csDestroying in ComponentState) then
    begin
      if FMasterLink.Active and (FMasterLink.Fields.Count > 0) and
        (PacketRecords = 0) then
        Params := Null else
        Params := Unassigned;
      if not (doNoResetCall in FDSOptions) then
      begin
        Options := [grReset];
        DoGetRecords(0, RecsOut, Byte(Options), '', Unassigned);
      end;
      FAppServer := nil;
    end;
  end
  else if FSavePacketOnClose and (FileName = '') and (ProviderName = '') and
     (DataSetField = nil) then
    SaveDataPacket;
  FDSBase := nil;
  FCloneSource := nil;
  FParentDataSet := nil;
end;

procedure TCustomClientDataSet.DefChanged(Sender: TObject);
begin
  FStoreDefs := True;
end;

procedure TCustomClientDataSet.InternalInitFieldDefs;
var
  FieldID, I: Integer;
  FieldDescs: TFieldDescList;
  CursorProps: DSProps;
begin
  FDSBase.SetProp(dspropCOMPRESSARRAYS, Integer(True));
  Check(FDSBase.GetProps(CursorProps));
  SetLength(FieldDescs, CursorProps.iFields);
  Check(FDSBase.GetFieldDescs(PDSFldDesc(FieldDescs)));
  FieldDefs.Clear;
  I := 0;
  FieldID := 1;
  while I < CursorProps.iFields do
    AddFieldDesc(FieldDescs, I, FieldID, FieldDefs);
end;

type
  TPropReader = class(TReader);

procedure TCustomClientDataSet.CheckFieldProps;

  procedure GetTypeName(Field: TObjectField);
  var
    V: Variant;
    i: Integer;
  begin
    V := InternalGetOptionalParam(szTYPENAME, Field.FieldNo);
    if not VarIsNull(V) and not VarIsClear(V) then
      Field.ObjectType := V;
    if Field.DataType in [ftADT, ftArray] then
      for i := 0 to Field.FieldCount - 1 do
        if Field.Fields[i] is TObjectField then
          GetTypeName(TObjectField(Field.Fields[i]));
  end;

var
  V: Variant;
  P: Pointer;
  Stream: TMemoryStream;
  Reader: TPropReader;
  i: Integer;
begin
  Stream := TMemoryStream.Create;
  try
    for i := 0 to FieldCount - 1 do
    begin
      if Fields[i] is TObjectField then
        GetTypeName(TObjectField(Fields[i]));
      V := InternalGetOptionalParam(szORIGIN, Fields[i].FieldNo);
      if not VarIsNull(V) and not VarIsClear(V) then
        Fields[i].Origin := VarToStr(V);
      V := InternalGetOptionalParam(szPROVFLAGS, Fields[i].FieldNo);
      if not (VarIsNull(V) or VarIsClear(V)) then
        Fields[i].ProviderFlags := TProviderFlags(Byte(V));
      V := InternalGetOptionalParam(szFIELDPROPS, Fields[i].FieldNo);
      if VarIsNull(V) or VarIsClear(V) or not VarIsArray(V) then continue;
      Stream.Size := VarArrayHighBound(V, 1);
      P := VarArrayLock(V);
      try
        Stream.Position := 0;
        Stream.Write(Pointer(Integer(P))^, Stream.Size);
        Stream.Position := 0;
      finally
        VarArrayUnlock(V);
      end;
      V := NULL;
      Reader := TPropReader.Create(Stream, 1024);
      try
        Reader.ReadListBegin;
        while not Reader.EndOfList do
          Reader.ReadProperty(Fields[i]);
      finally
        Stream.Clear;
        Reader.Free;
      end;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TCustomClientDataSet.InternalOpen;

  function GetBoolParam(const ParamName: string): Boolean;
  var
    V: OleVariant;
  begin
    V := GetOptionalParam(ParamName);
    Result := not VarIsNull(V) and not VarIsClear(V) and (VarType(V) = varBoolean);
    if Result then
      Result := V;
  end;

var
  CursorProps: DSProps;
begin
  if Assigned(FCloneSource) then
    FDSCursor := CreateDSCursor(FCloneSource.FDSCursor)
  else
  begin
    SetupInternalCalcFields(True);
    FDSCursor := CreateDSCursor(nil);
  end;
  if DataSetField <> nil then
    with FParentDataSet do
    begin
      if State = dsInActive then
      begin
        DSCursor.MoveToBOF;
        DSCursor.MoveRelative(1);
      end;
      Check(DSCursor.LinkCursors(0, nil, nil, Self.FDSCursor));
    end;
  FDSOptions := [];
  if GetBoolParam(szDISABLE_EDITS) then
    Include(FDSOptions, doDisableEdits);
  if GetBoolParam(szDISABLE_INSERTS) then
    Include(FDSOptions, doDisableInserts);
  if GetBoolParam(szDISABLE_DELETES) then
    Include(FDSOptions, doDisableDeletes);
  if GetBoolParam(szNO_RESET_CALL) then
    Include(FDSOptions, doNoResetCall);
  Check(FDSCursor.GetCursorProps(CursorProps));
  FRecordSize := CursorProps.iRecBufSize;
  BookmarkSize := CursorProps.iBookmarkSize;
  SetLength(FLastParentBM, BookMarkSize);
  FCanModify := not CursorProps.bReadOnly;
  FieldDefs.Updated := False;
  FieldDefs.Update;
  FieldDefList.Update;
  IndexDefs.Updated := False;
  GetIndexInfo('');
  if DefaultFields then CreateFields;
  BindFields(True);
  CheckFieldProps;
  AllocKeyBuffers;
  FDSCursor.MoveToBOF;
  if not Assigned(FCloneSource) then
  begin
    if InternalCalcFields and not (csDesigning in ComponentState) then
      Check(FDSBase.SetFieldCalculation(Integer(Self),
        @TCustomClientDataSet.CalcFieldsCallback));
    if FIndexName <> '' then
       if FFieldsIndex then
         SortOnFields(FDSCursor, FIndexName, False, False) else
         SwitchToIndex(FIndexName);
    CheckMasterRange;
    if DisableStringTrim then FDSBase.SetProp(dspropDISABLESTRINGTRIM, Integer(True));
    if FReadOnly then FDSBase.SetProp(dspropREADONLY, Integer(True));
    ResetAllAggs(FAggregatesActive);
    if Filtered then ActivateFilters;
  end;
  InitBufferPointers(False);
  if (DataSetField <> nil) and FetchOnDemand then
    CheckDetailRecords;
  SetupConstraints;
end;

procedure TCustomClientDataSet.InternalClose;
begin
  if Filtered then DeactivateFilters;
  FreeKeyBuffers;
  if not Assigned(FCloneSource) then
    SetupInternalCalcFields(False);
  BindFields(False);
  if DefaultFields then DestroyFields;
  CloseAggs;
  FIndexFieldCount := 0;
  FKeySize := 0;
  FDSCursor := nil;
  FFindCursor := nil;
  FNotifyCallback := False;
end;

procedure TCustomClientDataSet.InternalRefresh;
const
  Options: TGetRecordOptions = [grReset];
var
  SeqNo: DWord;
  RecCount, RecsOut: Integer;
  DataPacket: TDataPacket;
begin
  CheckBrowseMode;
  if ChangeCount > 0 then
    DatabaseError(SRefreshError, Self);
  if FMasterLink.Active and (FMasterLink.Fields.Count > 0) and
     ((DataSetField <> nil) or (PacketRecords <> -1)) then
  begin
    FDSBase.Reset;
    if FetchOnDemand then CheckDetailRecords;
  end else
  begin
    FDSCursor.GetSequenceNumber(SeqNo);
    if not ProviderEOF then
      FDSBase.GetProp(dspropRECORDSINDS, @RecCount) else
      RecCount := AllRecords;
    DataPacket := VarToDataPacket(DoGetRecords(RecCount, RecsOut, Byte(Options), '', Unassigned));
    ProviderEOF := RecsOut <> RecCount;
    FDSBase.Reset;
    FDSBase.SetProp(dspropDSISPARTIAL, Integer(False));
    Check(FDSBase.AppendData(DataPacket, ProviderEOF));
    FDSCursor.MoveToSeqNo(SeqNo);
  end;
end;

function TCustomClientDataSet.IsCursorOpen: Boolean;
begin
  Result := FDSCursor <> nil;
end;

procedure TCustomClientDataSet.InternalHandleException;
begin
 if Assigned(Classes.ApplicationHandleException) then
   ApplicationHandleException(Self);
end;

function TCustomClientDataSet.GetData: OleVariant;
var
  DataPacket: TDataPacket;
begin
  if Active then
  begin
    CheckBrowseMode;
    FDSBase.SetProp(dspropXML_STREAMMODE, xmlOFF);
    Check(FDSBase.StreamDS(DataPacket));
  end else
    SafeArrayCheck(SafeArrayCopy(FSavedPacket, DataPacket));
  DataPacketToVariant(DataPacket, Result);
end;

procedure TCustomClientDataSet.SetData(const Value: OleVariant);
begin
  FSavePacketOnClose := False;
  Close;
  ClearSavedPacket;
  if not VarIsNull(Value) then
  begin
    SafeArrayCheck(SafeArrayCopy(VarToDataPacket(Value), FSavedPacket));
    Open;
  end;
end;

function TCustomClientDataSet.GetXMLData: string;
var
  DataPacket: TDataPacket;
  VarPacket: OleVariant;
begin
  if Active then
  begin
    CheckBrowseMode;
    FDSBase.SetProp(dspropXML_STREAMMODE, xmlON);
    Check(FDSBase.StreamDS(DataPacket));
    DataPacketToVariant(DataPacket, VarPacket);
    Result := VariantArrayToString(VarPacket);
  end;
end;

procedure TCustomClientDataSet.SetXMLData(const Value: string);
begin
  SetData(StringToVariantArray(Value)); 
end;

procedure TCustomClientDataSet.ClearSavedPacket;
begin
  FreeDataPacket(FSavedPacket);
end;

procedure TCustomClientDataSet.SaveDataPacket(Format: TDataPacketFormat);
const
  StreamMode: array[TDataPacketFormat] of DWord = (xmlOFF, xmlON, xmlUTF8);
begin
  if Assigned(FDSBase) and (DataSetField = nil) then
  begin
    FDSBase.SetProp(dspropXML_STREAMMODE, StreamMode[Format]);
    ClearSavedPacket;
    Check(FDSBase.StreamDS(FSavedPacket));
  end;
end;

function TCustomClientDataSet.GetDataSize: Integer;
begin
  if Assigned(DataSetField) then
    Result := -1
  else if Active then
  begin
    SaveDataPacket;
    Result := DataPacketSize(FSavedPacket);
    ClearSavedPacket;
  end
  else if Assigned(FSavedPacket) then
    Result := DataPacketSize(FSavedPacket)
  else
    Result := 0;
end;

procedure TCustomClientDataSet.FetchMoreData(All: Boolean);
var
  Count: Integer;
  RecsOut: Integer;
begin
  if All then Count := AllRecords else Count := FPacketRecords;
  if Count = 0 then Exit;
  AddDataPacket(DoGetRecords(Count, RecsOut, 0, '', Unassigned), RecsOut <> Count);
  ProviderEOF := RecsOut <> Count;
end;

procedure TCustomClientDataSet.InternalFetch(Options: TFetchOptions);
var
  DataPacket: TDataPacket;
  NewData: OleVariant;
  BaseDS: TCustomClientDataSet;
begin
  CheckActive;             
  UpdateCursorPos;
  Check(DSCursor.GetRowRequestPacket(foRecord in Options, foBlobs in Options,
    foDetails in Options, True, DataPacket));
  DataPacketToVariant(DataPacket, NewData);
  BaseDS := Self;
  while Assigned(BaseDS.FParentDataSet) do BaseDS := BaseDS.FParentDataSet;
  NewData := BaseDS.DoRowRequest(NewData, Byte(Options));
  UpdateCursorPos;
  Check(DSCursor.RefreshRecord(VarToDataPacket(NewData)));
  DSCursor.GetCurrentRecord(ActiveBuffer);