ddhdsone.pas

Delphi高级开发指南是开发程序的好帮手

begin
  ReqBookmark := PInteger (Bookmark)^;
//  ShowMessage ('InternalGotoBookmark: ' +
//    IntToStr (ReqBookmark));
  if (ReqBookmark >= 0) and (ReqBookmark < FRecordCount) then
    FCurrentRecord := ReqBookmark
  else
    raise EDataSetOneError.Create ('Bookmark ' +
      IntToStr (ReqBookmark) + ' not found');
end;

// II: same as above (but passes a buffer)
procedure TDdhDataSetOne.InternalSetToRecord (Buffer: PChar);
var
  ReqBookmark: Integer;
begin
//  ShowMessage ('InternalSetToRecord');
  ReqBookmark := PRecInfo(Buffer + FRecordInfoOffset).Bookmark;
  InternalGotoBookmark (@ReqBookmark);
end;

// II: retrieve bookmarks flags from buffer
function TDdhDataSetOne.GetBookmarkFlag (
  Buffer: PChar): TBookmarkFlag;
begin
//  ShowMessage ('GetBookmarkFlag');
  Result := PRecInfo(Buffer + FRecordInfoOffset).BookmarkFlag;
end;

// II: change the bookmark flags in the buffer
procedure TDdhDataSetOne.SetBookmarkFlag (Buffer: PChar;
  Value: TBookmarkFlag);
begin
//  ShowMessage ('SetBookmarkFlag');
  PRecInfo(Buffer + FRecordInfoOffset).BookmarkFlag := Value;
end;

// II: read the bookmark data from record buffer
procedure TDdhDataSetOne.GetBookmarkData (
  Buffer: PChar; Data: Pointer);
begin
//  ShowMessage ('GetBookmarkData: ' + IntToStr (PRecInfo(Buffer + FRecordInfoOffset).Bookmark));
  PInteger(Data)^ :=
    PRecInfo(Buffer + FRecordInfoOffset).Bookmark;
end;

// II: set the bookmark data in the buffer
procedure TDdhDataSetOne.SetBookmarkData (
  Buffer: PChar; Data: Pointer);
begin
//  ShowMessage ('SetBookmarkData: ' + IntToStr (PInteger(Data)^));
  PRecInfo(Buffer + FRecordInfoOffset).Bookmark :=
    PInteger(Data)^;
end;

// II: Go to a special position before the first record
procedure TDdhDataSetOne.InternalFirst;
begin
  FCurrentRecord := BofCrack;
end;

// II: Go to a special position after the last record
procedure TDdhDataSetOne.InternalLast;
begin
  EofCrack := FRecordCount;
  FCurrentRecord := EofCrack;
end;

// II (optional): Record count
function TDdhDataSetOne.GetRecordCount: Longint;
begin
  CheckActive;
  Result := FRecordCount;
end;

// II (optional): Get the number of the current record
function TDdhDataSetOne.GetRecNo: Longint;
begin
  UpdateCursorPos;
  if FCurrentRecord < 0 then
    Result := 1
  else
    Result := FCurrentRecord + 1;
end;

// II (optional): Move to the given record number
procedure TDdhDataSetOne.SetRecNo(Value: Integer);
begin
  CheckBrowseMode;
  if (Value > 1) and (Value <= FRecordCount) then
  begin
    FCurrentRecord := Value - 1;
    Resync([]);
  end;
end;

//////////////////////////////////////////
////// Part III:
////// Record buffers and field management
//////////////////////////////////////////

/// III: Determine the size of each record buffer in memory
function TDdhDataSetOne.GetRecordSize: Word;
begin
  Result := FRecordSize; // data only
end;

/// III: Allocate a buffer for the record
function TDdhDataSetOne.AllocRecordBuffer: PChar;
begin
  Result := StrAlloc(FRecordBufferSize);
end;

// III: Initialize the record (set to zero)
procedure TDdhDataSetOne.InternalInitRecord(Buffer: PChar);
begin
  FillChar(Buffer^, FRecordBufferSize, 0);
end;

// III: Free the buffer
procedure TDdhDataSetOne.FreeRecordBuffer (var Buffer: PChar);
begin
  StrDispose(Buffer);
end;

// III: Retrieve data for current, previous, or next record
// (eventually moving to it) and return the status
function TDdhDataSetOne.GetRecord(Buffer: PChar;
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  if FRecordCount < 1 then
    Result := grEOF
  else
  begin
    Result := grOK;
    case GetMode of
      gmNext:
      begin
        // ShowMessage ('GetRecord Next');
        // if next record is not out of range...
        if FCurrentRecord >= FRecordCount - 1 then
          Result := grEOF
        else
          Inc (FCurrentRecord);
      end;
      gmPrior:
      begin
        // ShowMessage ('GetRecord Prior');
        // if previous message is not out of range
        if FCurrentRecord <= 0 then
          Result := grBOF
        else
          Dec (FCurrentRecord);
      end;
      gmCurrent:
      begin
        // ShowMessage ('GetRecord Current');
        if (FCurrentRecord >= FRecordCount) or
            (FCurrentRecord < 0) then
          Result := grError;
      end;
    end;
    // load the data
    if Result = grOK then
    begin
      FStream.Position := FDataFileHeaderSize +
        FRecordSize * FCurrentRecord;
      FStream.ReadBuffer (Buffer^, FRecordSize);
      with PRecInfo(Buffer + FRecordInfoOffset)^ do
      begin
        BookmarkFlag := bfCurrent;
        Bookmark := FCurrentRecord;
      end;
    end
    else
      if (Result = grError) and DoCheck then
        raise EDataSetOneError.Create (
          'GetRecord: Invalid record');
  end;
end;

// III: Write the current data to the file
procedure TDdhDataSetOne.InternalPost;
begin
  CheckActive;
  if State = dsEdit then
  begin
    // replace data with new data
    FStream.Position := FDataFileHeaderSize +
      FRecordSize * FCurrentRecord;
    FStream.WriteBuffer (ActiveBuffer^, FRecordSize);
  end
  else
  begin
    // always append
    InternalLast;
    FStream.Seek (0, soFromEnd);
    FStream.WriteBuffer (ActiveBuffer^, FRecordSize);
    Inc (FRecordCount);
  end;
end;

// III: Add the current data to the file
procedure TDdhDataSetOne.InternalAddRecord(
  Buffer: Pointer; Append: Boolean);
begin
  // always append
  InternalLast;
  // add record at the end of the file
  FStream.Seek (0, soFromEnd);
  FStream.WriteBuffer (ActiveBuffer^, FRecordSize);
  Inc (FRecordCount);
end;

// III: Delete the current record
procedure TDdhDataSetOne.InternalDelete;
begin
  // not supported in this version
  raise EDataSetOneError.Create (
    'Delete: Operation not supported');
end;

// III: Move data from record buffer to field
function TDdhDataSetOne.GetFieldData (
  Field: TField; Buffer: Pointer): Boolean;
var
  FieldOffset: Integer;
  Ptr: PChar;
begin
  Result := False;
  if not IsEmpty and (Field.FieldNo > 0) then
  begin
    FieldOffset := Integer (
      FFieldOffset [Field.FieldNo - 1]);
    Ptr := ActiveBuffer;
    Inc (Ptr, FieldOffset);
    Move (Ptr^, Buffer^, Field.DataSize);
    Result := True;
  end;
end;

// III: Move data from field to record buffer
procedure TDdhDataSetOne.SetFieldData(Field: TField; Buffer: Pointer);
var
  FieldOffset: Integer;
  Ptr: PChar;
begin
  if Field.FieldNo >= 0 then
  begin
    FieldOffset := Integer (
      FFieldOffset [Field.FieldNo - 1]);
    Ptr := ActiveBuffer;
    Inc (Ptr, FieldOffset);
    if Assigned (Buffer) then
      Move (Buffer^, Ptr^, Field.DataSize)
    else
      ShowMessage ('very bad error in setfield data');
    DataEvent (deFieldChange, Longint(Field));
  end;
end;

// default exception handling

procedure TDdhDataSetOne.InternalHandleException;
begin
  // standard exception handling
  Application.HandleException(Self);
end;

procedure Register;
begin
  RegisterComponents('DDHB DB', [TDdhDataSetOne]);
end;

end.