fastdbdataset.pas

俄国人写的内存数据库的delphi封装

// TFastDbDataSet
//---------------------------------------------------------------------------
constructor TFastDbDataSet.Create(AOwner: TComponent);
begin
  inherited;
  FQuery       := TFastDbQuery.Create(Self);
  FUpdateQuery := TFastDbQuery.Create(Self);
  FUpdateFields:= TFastDbFields.Create(Self);
  FReadOnly    := True;
  CreateRecIDField;
end;

//---------------------------------------------------------------------------
destructor TFastDbDataSet.Destroy;
begin
  FQuery.Free;
  FUpdateQuery.Free;
  FUpdateFields.Free;
  inherited;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalLoadCurrentRecord(Buffer: PChar);
begin
  FQuery.Skip(FCurrentRecord - Integer(FQuery.RecNo));
  //PInteger (Buffer)^ := FCurrentRecord;
  with PMdRecInfo(Buffer + FRecordSize)^ do
  begin
    BookmarkFlag := bfCurrent;
    Bookmark := FCurrentRecord;
  end;
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetSql: string;
begin
  Result := FQuery.Sql;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.SetSql(const Value: string);
begin
  FQuery.Sql := Value;
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetFields: TFastDbFields;
begin
  Result := FQuery.Fields;
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetSession: TFastDbSession;
begin
  Result := FQuery.Session;
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetVariables: TFastDbVariables;
begin
  Result := FQuery.Variables;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.SetVariables(const Value: TFastDbVariables);
begin
  FQuery.Variables.Assign(Value);
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.SetSession(const Value: TFastDbSession);
begin
  FQuery.Session := Value;
  FUpdateQuery.Session := Value;
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetCanModify: Boolean;
begin
  Result := not FReadOnly;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalHandleException;
begin
  // special purpose exception handling
  // do nothing
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  nCurRec : Integer;
  flds : TFastDbFields;
  fld  : TFastDbField;
begin
  Result := False;
  if not IsEmpty and (Field.FieldNo > 0) then
    begin
      nCurRec := PMdRecInfo(ActiveBuffer + FRecordSize)^.Bookmark;
      FQuery.Skip(nCurRec - Integer(FQuery.RecNo));
      Result := True;

      case State of
        dsEdit, dsInsert:
          flds := FUpdateFields;
      else
        flds := FQuery.Fields;
      end;

      fld := flds[Field.FieldNo-1];

      if Assigned (Buffer) then
        if fld.FieldType = ctString then begin
          StrPCopy(PChar(Buffer), fld.asString);
          Result := True;
        end else if not IsArrayType(fld.FieldType) then begin
          Move(fld.asPointer^, Buffer^, fld.FieldSize);
          Result := True;
        end else
          Result := False;
      if (Field is TDateTimeField) and (fld.asDateTime = 0) then
        Result := False;
    end;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalInitFieldDefs;
var
  i   : Integer;
  nSize: Integer;
begin
  FieldDefs.Clear;
  for i:=0 to FQuery.Fields.Count-1 do begin
    case DsFieldTypeOfCliType[FQuery.Fields[i].FieldType] of
      ftBytes : nSize := 1;  //ctInt1
      ftArray : nSize := FQuery.Fields[i].ArraySize;
      ftString: nSize := 80; // Use some default value
    else
      nSize := 0;
    end;
    FieldDefs.Add(FQuery.Fields[i].Name,
                  DsFieldTypeOfCliType[FQuery.Fields[i].FieldType],
                  nSize, True);
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
  nCurRec : Integer;
  i : Integer;
begin
  if Field.FieldNo >= 0 then
    begin
      nCurRec := PMdRecInfo(ActiveBuffer + FRecordSize)^.Bookmark;
      FQuery.Skip(nCurRec - Integer(FQuery.RecNo));  // Position the record

      if Assigned (Buffer) then
        with FUpdateFields[Field.FieldNo-1] do
          case DsFieldTypeOfCliType[FieldType] of
            ftBytes:  SetValue(Buffer, TBytesField(Field).Size);
            ftString: asString := PChar(Buffer);
            ftArray : for i:=0 to TArrayField(Field).Size-1 do
                        case FieldType of
                          ctArrayOfOID,
                          ctArrayOfInt4,
                          ctArrayOfBool,
                          ctArrayOfInt1,
                          ctArrayOfInt2,
                          ctArrayOfInt8:
                            asArrayInt8[i]   := VarAsType(TArrayField(Field).FieldValues[i], varInt64);
                          ctArrayOfReal4,
                          ctArrayOfReal8:
                            asArrayDouble[i] := VarAsType(TArrayField(Field).FieldValues[i], varDouble);
                          ctArrayOfString:
                            asArrayString[i] := VarAsType(TArrayField(Field).FieldValues[i], varString);
                        else
                          raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [Name, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
                        end;
          else
            SetValue(Buffer, FieldSize);
          end;

      DataEvent (deFieldChange, Longint(Field));
    end;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.SetReadOnly(const Value: Boolean);
begin
  if FQuery.IsOpen then
    raise EFastDbQuery.Create('Cannot modify property of an active dataset!');
  FReadOnly := Value;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
  // always append at the end
  InternalLast;

  FUpdateQuery.Fields.ClearValues;
  {with TFastDbQuery.Create(nil) do
  try
    Fields.Assign(FQuery.Fields);
    Sql := 'insert into '+FQuery.TableName;
    Session := FQuery.Session;
    FQuery.Freeze;
    Insert;
  finally
    Free;
    FQuery.UnFreeze;
  end;}
end;

//---------------------------------------------------------------------------
function TFastDbDataSet.PrepareUpdateQuery(const AUpdateType: TUpdateKind;
  const CurrentOID: TCliOID): TCliOID;

  procedure CopyValues(AFrom, ATo: TFastDbFields);
  var i : Integer;
  begin
    for i:=0 to AFrom.Count-1 do
      ATo[i].CopyTypeAndValue(AFrom[i]);
  end;
begin
  FUpdateQuery.ClearVariables;

  case AUpdateType of
    ukInsert:
      begin
        FUpdateQuery.Sql := Format('insert into %s', [FQuery.TableName]);


        CopyValues(FUpdateFields, FUpdateQuery.Fields);
        Result := FUpdateQuery.Insert;
      end;
    ukModify:
      begin
        FUpdateQuery.Sql := Format('select * from %s where current = %%oid', [FQuery.TableName]);
        FUpdateQuery.Variables.Add('oid', ctOid, @CurrentOID);

        if FUpdateQuery.Execute(False) = 1 then
          begin
            CopyValues(FUpdateFields, FUpdateQuery.Fields);
            FUpdateQuery.Update;
          end;

        Result := CurrentOID;
      end;
    ukDelete:
      begin
        FQuery.Next;
        Result := FQuery.OID;
        FQuery.Prev;

        FUpdateQuery.Sql := Format('select * from %s where current = %%oid', [FQuery.TableName]);
        FUpdateQuery.Variables.Add('oid', ctOid, @CurrentOID);

        if FUpdateQuery.Execute(False) = 1 then
          FUpdateQuery.Delete;
      end;
  else
    raise EFastDbError.Create('Unknown update type!');
  end;

  FUpdateQuery.Close;
end;

//---------------------------------------------------------------------------
// III: Delete the current record
procedure TFastDbDataSet.InternalDelete;
var
  oid : TCliOID;

begin
  CheckActive;
  DisableControls;
  try
    InternalLoadCurrentRecord(ActiveBuffer);      //!!! Investigate the need for this one

    oid := PrepareUpdateQuery(ukDelete, FQuery.OID);
    FQuery.Close;
    FQuery.Session.Commit(True);
    FQuery.Execute;

    FCurrentRecord := FQuery.Seek(oid);
    InternalLoadCurrentRecord(ActiveBuffer);
  finally
    EnableControls;
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalPost;
var
  oid : TCliOID;
begin
  CheckActive;
  DisableControls;
  try
    InternalLoadCurrentRecord(ActiveBuffer);      //!!! Investigate the need for this one

    if State = dsEdit then
      begin
        oid := PrepareUpdateQuery(ukModify, FQuery.OID);

        //FQuery.RefreshRecord;

        FQuery.Close;
        FQuery.Session.Commit(True);
        FQuery.Execute;
        //FQuery.Freeze;
        //FQuery.Unfreeze;
        FCurrentRecord := FQuery.Seek(oid);
        InternalLoadCurrentRecord(ActiveBuffer);
      end
    else
      begin
        // always append
        InternalLast;

        FUpdateQuery.Sql := Format('insert into %s', [FQuery.TableName]);
        FUpdateQuery.Fields.Assign(FUpdateFields);
        FUpdateQuery.ClearVariables;

        FUpdateQuery.Insert;

        FQuery.Close;
        FQuery.Execute;
        FQuery.Last;
      end;
  finally
    EnableControls;
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalRefresh;
begin
  FQuery.Close;
  FQuery.Execute;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalCancel;
begin
  FUpdateFields.ClearValues;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalEdit;
var nCurRec : Integer;
begin
  // Ensure we are positioned at the right record
  nCurRec := PMdRecInfo(ActiveBuffer + FRecordSize)^.Bookmark;
  FQuery.Skip(nCurRec - Integer(FQuery.RecNo));

  // Buffer current record values
  FUpdateFields.Assign(FQuery.Fields);
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.InternalInsert;
begin
  // Get current field metadata
  FUpdateFields.Assign(FQuery.Fields);
  FUpdateFields.ClearValues;
end;

//---------------------------------------------------------------------------
procedure TFastDbDataSet.CreateRecIDField;
begin
  if (FRecIdField <> nil) then exit;
  FRecIdField := TIntegerField.Create(self);
  with FRecIdField do
  begin
    FieldName := 'RecID';
    DataSet := self;
    Name := self.Name + FieldName;
    Calculated := True;
    Visible := False;
  end;
end;

end.