ibcustomdataset.pas

这是不可多得的源代码

        pbd^[j].Finalize;
        PISC_QUAD(
          PChar(Buff) + PRecordData(Buff)^.rdFields[k].fdDataOfs)^ :=
          pbd^[j].BlobID;
        PRecordData(Buff)^.rdFields[k].fdIsNull := pbd^[j].Size = 0;
      end;
      Inc(j);
    end;
  if Assigned(FUpdateObject) then
  begin
    if (Qry = FQDelete) then
      FUpdateObject.Apply(ukDelete)
    else
      if (Qry = FQInsert) then
        FUpdateObject.Apply(ukInsert)
      else
        FUpdateObject.Apply(ukModify);
  end
  else
  begin
    SetInternalSQLParams(Qry, Buff);
    Qry.ExecQuery;
    FRowsAffected := Qry.RowsAffected; 
  end;
  PRecordData(Buff)^.rdUpdateStatus := usUnmodified;
  PRecordData(Buff)^.rdCachedUpdateStatus := cusUnmodified;
  SetModified(False);
  WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
  if (FForcedRefresh or FNeedsRefresh) and CanRefresh then
    InternalRefreshRow;
end;

procedure TIBCustomDataSet.InternalRefreshRow;
var
  Buff: PChar;
  ofs: DWORD;
  Qry: TIBSQL;
begin
  Qry := nil;
  Buff := GetActiveBuf;
  if CanRefresh then
  begin
    if Buff <> nil then
    begin
      if (Assigned(FUpdateObject) and (FUpdateObject.RefreshSQL.Text <> '')) then
      begin
        Qry := TIBSQL.Create(self);
        Qry.Database := Database;
        Qry.Transaction := Transaction;
        Qry.GoToFirstRecordOnExecute := False;
        Qry.SQL.Text := FUpdateObject.RefreshSQL.Text;
      end
      else
        Qry := FQRefresh;
      SetInternalSQLParams(Qry, Buff);
      Qry.ExecQuery;
      try
        if (Qry.SQLType = SQLExecProcedure) or
           (Qry.Next <> nil) then
        begin
          ofs := PRecordData(Buff)^.rdSavedOffset;
          FetchCurrentRecordToBuffer(Qry,
                                     PRecordData(Buff)^.rdRecordNumber,
                                     Buff);
          if FCachedUpdates and (ofs <> $FFFFFFFF) then
          begin
            PRecordData(Buff)^.rdSavedOffset := ofs;
            WriteRecordCache(PRecordData(Buff)^.rdRecordNumber, Buff);
            SaveOldBuffer(Buff);
          end;
        end;
      finally
        Qry.Close;
      end;
    end;
    if Qry <> FQRefresh then
      Qry.Free;
  end
  else
    IBError(ibxeCannotRefresh, [nil]);
end;

procedure TIBCustomDataSet.InternalRevertRecord(RecordNumber: Integer);
var
  NewBuffer, OldBuffer: PRecordData;

begin
  NewBuffer := nil;
  OldBuffer := nil;
  NewBuffer := PRecordData(AllocRecordBuffer);
  OldBuffer := PRecordData(AllocRecordBuffer);
  try
    ReadRecordCache(RecordNumber, PChar(NewBuffer), False);
    ReadRecordCache(RecordNumber, PChar(OldBuffer), True);
    case NewBuffer^.rdCachedUpdateStatus of
      cusInserted:
      begin
        NewBuffer^.rdCachedUpdateStatus := cusUninserted;
        Inc(FDeletedRecords);
      end;
      cusModified,
      cusDeleted:
      begin
        if (NewBuffer^.rdCachedUpdateStatus = cusDeleted) then
          Dec(FDeletedRecords);
        CopyRecordBuffer(OldBuffer, NewBuffer);
      end;
    end;

    if State in dsEditModes then
      Cancel;

    WriteRecordCache(RecordNumber, PChar(NewBuffer));

    if (NewBuffer^.rdCachedUpdateStatus = cusUninserted ) then
      ReSync([]);
  finally
    FreeRecordBuffer(PChar(NewBuffer));
    FreeRecordBuffer(PChar(OldBuffer));
  end;
end;

{ A visible record is one that is not truly deleted,
  and it is also listed in the FUpdateRecordTypes set }

function TIBCustomDataSet.IsVisible(Buffer: PChar): Boolean;
begin
  result := True;
  if not (State = dsOldValue) then
    result :=
      (PRecordData(Buffer)^.rdCachedUpdateStatus in FUpdateRecordTypes) and
      (not ((PRecordData(Buffer)^.rdCachedUpdateStatus = cusUnmodified) and
        (PRecordData(Buffer)^.rdUpdateStatus = usDeleted)));
end;


function TIBCustomDataSet.LocateNext(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  b : TBookmark;
begin
  DisableControls;
  b := GetBookmark;
  try
    Next;
    Result := InternalLocate(KeyFields, KeyValues, Options);
    if not Result then
      GotoBookmark(b);  // Get back on the record we started with on failure
  finally
    FreeBookmark(b);
    EnableControls;
  end;
end;

procedure TIBCustomDataSet.InternalPrepare;
var
  DidActivate: Boolean;
begin
  if FInternalPrepared then
    Exit;
  if Trim(FQSelect.SQL.Text) = '' then
    IBError(ibxeEmptySQLStatement, []);
  DidActivate := False;
  try
    ActivateConnection;
    DidActivate := ActivateTransaction;
    FBase.CheckDatabase;
    FBase.CheckTransaction;
    if Trim(FQSelect.SQL.Text) <> '' then
    begin
      if not FQSelect.Prepared then
      begin
        FQSelect.ParamCheck := ParamCheck;
        FQSelect.Prepare;
      end;
      FLiveMode := [];
      try
        if Trim(FQDelete.SQL.Text) <> '' then
        begin
          if not FQDelete.Prepared then
            FQDelete.Prepare;
          Include(FLiveMode, lmDelete);
        end;
      except
       on E: Exception do
         if not (E is EIBInterbaseRoleError) then
           Raise;
      end;

      try
        if Trim(FQInsert.SQL.Text) <> '' then
        begin
          if not FQInsert.Prepared then
            FQInsert.Prepare;
          Include(FLiveMode, lmInsert);
        end;
      except
       on E: Exception do
         if not (E is EIBInterbaseRoleError) then
           Raise;
      end;

      try
        if Trim(FQModify.SQL.Text) <> '' then
        begin
          if not FQModify.Prepared then
            FQModify.Prepare;
          Include(FLiveMode, lmModify);
        end;
      except
       on E: Exception do
         if not (E is EIBInterbaseRoleError) then
           Raise;
      end;

      try
       if Trim(FQRefresh.SQL.Text) <> '' then
       begin
         if not FQRefresh.Prepared then
           FQRefresh.Prepare;
         Include(FLiveMode, lmRefresh);
       end;
      except
       on E: Exception do
         if not (E is EIBInterbaseRoleError) then
           Raise;
      end;

      FInternalPrepared := True;
      InternalInitFieldDefs;
    end 
    else
      IBError(ibxeEmptyQuery, [nil]);
  finally
    if DidActivate then
      DeactivateTransaction;
  end;
end;

procedure TIBCustomDataSet.RecordModified(Value: Boolean);
begin
  SetModified(Value);
end;

procedure TIBCustomDataSet.RevertRecord;
var
  Buff: PRecordData;
begin
  if FCachedUpdates and FUpdatesPending then
  begin
    Buff := PRecordData(GetActiveBuf);
    InternalRevertRecord(Buff^.rdRecordNumber);
    ReadRecordCache(Buff^.rdRecordNumber, PChar(Buff), False);
    DataEvent(deRecordChange, 0);
  end;
end;

procedure TIBCustomDataSet.SaveOldBuffer(Buffer: PChar);
var
  OldBuffer: Pointer;
  procedure CopyOldBuffer;
  begin
    CopyRecordBuffer(Buffer, OldBuffer);
    if BlobFieldCount > 0 then
      FillChar(PChar(OldBuffer)[FBlobCacheOffset], BlobFieldCount * SizeOf(TIBBlobStream),
               0);
  end;

begin
  if (Buffer <> nil) and (PRecordData(Buffer)^.rdRecordNumber >= 0) then
  begin
    OldBuffer := AllocRecordBuffer;
    try
      if (PRecordData(Buffer)^.rdSavedOffset = $FFFFFFFF) then
      begin
        PRecordData(Buffer)^.rdSavedOffset := AdjustPosition(FOldBufferCache, 0,
                                                             FILE_END);
        CopyOldBuffer;
          WriteCache(FOldBufferCache, 0, FILE_CURRENT, OldBuffer);
          WriteCache(FBufferCache, PRecordData(Buffer)^.rdRecordNumber * FRecordBufferSize,
                     FILE_BEGIN, Buffer);
      end
      else begin
        CopyOldBuffer;
        WriteCache(FOldBufferCache, PRecordData(Buffer)^.rdSavedOffset, FILE_BEGIN,
                   OldBuffer);
      end;
    finally
      FreeRecordBuffer(PChar(OldBuffer));
    end;
  end;
end;

procedure TIBCustomDataSet.SetBufferChunks(Value: Integer);
begin
  if (Value <= 0) then
    FBufferChunks := BufferCacheSize
  else
    FBufferChunks := Value;
end;

procedure TIBCustomDataSet.SetDatabase(Value: TIBDatabase);
begin
  if (FBase.Database <> Value) then
  begin
    CheckDatasetClosed;
    FBase.Database := Value;
    FQDelete.Database := Value;
    FQInsert.Database := Value;
    FQRefresh.Database := Value;
    FQSelect.Database := Value;
    FQModify.Database := Value;
  end;
end;

procedure TIBCustomDataSet.SetDeleteSQL(Value: TStrings);
begin
  if FQDelete.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQDelete.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetInsertSQL(Value: TStrings);
begin
  if FQInsert.SQL.Text <> Value.Text then
  begin
    Disconnect;
    FQInsert.SQL.Assign(Value);
  end;
end;

procedure TIBCustomDataSet.SetInternalSQLParams(Qry: TIBSQL; Buffer: Pointer);
var
  i, j: Integer;
  cr, data: PChar;
  fn, st: string;
  OldBuffer: Pointer;
  ts: TTimeStamp;
begin
  if (Buffer = nil) then
    IBError(ibxeBufferNotSet, [nil]);
  if (not FInternalPrepared) then
    InternalPrepare;
  OldBuffer := nil;
  try
    for i := 0 to Qry.Params.Count - 1 do
    begin
      fn := Qry.Params[i].Name;
      if (Pos('OLD_', fn) = 1) then {mbcs ok}
      begin
        fn := Copy(fn, 5, Length(fn));
        if not Assigned(OldBuffer) then
        begin
          OldBuffer := AllocRecordBuffer;
          ReadRecordCache(PRecordData(Buffer)^.rdRecordNumber, OldBuffer, True);
        end;
        cr := OldBuffer;
      end
      else if (Pos('NEW_', fn) = 1) then {mbcs ok}
           begin
             fn := Copy(fn, 5, Length(fn));
             cr := Buffer;
            end
            else
             cr := Buffer;
      j := FQSelect.FieldIndex[fn] + 1;
      if (j > 0) then
        with PRecordData(cr)^ do
        begin
          if Qry.Params[i].name = 'IBX_INTERNAL_DBKEY' then {do not localize}
          begin
            PIBDBKey(Qry.Params[i].AsPointer)^ := rdDBKey;
            continue;
          end;
          if rdFields[j].fdIsNull then
            Qry.Params[i].IsNull := True
          else begin
            Qry.Params[i].IsNull := False;
            data := cr + rdFields[j].fdDataOfs;
            case rdFields[j].fdDataType of
              SQL_TEXT, SQL_VARYING:
              begin
                SetString(st, data, rdFields[j].fdDataLength);
                Qry.Params[i].AsString := st;
              end;
            SQL_FLOAT, SQL_DOUBLE, SQL_D_FLOAT:
              Qry.Params[i].AsDouble := PDouble(data)^;
            SQL_SHORT, SQL_LONG:
            begin
              if rdFields[j].fdDataScale = 0 then
                Qry.Params[i].AsLong := PLong(data)^
              else if rdFields[j].fdDataScale >= (-4) then
                Qry.Params[i].AsCurrency := PCurrency(data)^
              else
                Qry.Params[i].AsDouble := PDouble(data)^;
            end;
            SQL_INT64:
            begin
              if rdFields[j].fdDataScale = 0 then
                Qry.Params[i].AsInt64 := PInt64(data)^
              else if rdFields[j].fdDataScale >= (-4) then
                Qry.Params[i].AsCurrency := PCurrency(data)^
              else
                Qry.Params[i].AsDouble := PDouble(data)^;
            end;
            SQL_BLOB, SQL_ARRAY, SQL_QUAD:
              Qry.Params[i].AsQuad := PISC_QUAD(data)^;
            SQL_TYPE_DATE:
            begin
              ts.Date := PInt(data)^;
              ts.Time := 0;
              Qry.Params[i].AsDate :=
                TimeStampToDateTim