dbf.pas

OICQ黑客工具。可以查看对方IP地址

            end; {while}
          while (leftP < rightP) do
            begin

              retval := _CompareRecords(SortFields,pivotP, rightP);
              if (retval < 0) then
                Dec(rightP)
              else
                begin
                  _SwapRecords(leftP, rightP);
                  if (retval <> 0) then
                    begin
                      Inc(leftP);
                      Dec(rightP);
                    end;
                  break;
                end;
            end; {while}

        until (leftP >= rightP);
      qBreak:
        if (_CompareRecords(SortFields,leftP, pivotP) <= 0) then Inc(leftP);
        leftTemp := leftP -1;
        pivotTemp := pivotP;
        while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
          begin
            _SwapRecords(pivotTemp, leftTemp);
            Inc(pivotTemp);
            Dec(leftTemp);
          end; {while}
        lNum := (leftP - pivotEnd);
        nElem := ((nElem + pivotP) -leftP);

        if (nElem < lNum) then
          begin
            qSortHelp(leftP, nElem);
            nElem := lNum;
          end
        else
          begin
            qSortHelp(pivotP, lNum);
            pivotP := leftP;
          end;
        goto TailRecursion;
      end; {qSortHelp }

  begin
    if (uNElem < 2) then  exit; { nothing to sort }
    qSortHelp(1, uNElem);
  end; { QSort }


BEGIN
  CheckActive;
  if fReadOnly then
    raise eDBFError.Create ('Dataset must be opened for read/write to perform sort.');
//  if fDataFileHeader.DeletedCount > 0 then
//    BEGIN
//      Close;
//      PackTable;
//      Open;
//    END;
  QSort(FRecordCount {+ fDeletedCount});
  First;
END;

// ____________________________________________________________________________
// TDBF.UnsortTable
// Used to help test the sort routine.  Attempts to generate a random
// dispersment of the records in the dataset.
Procedure TDBF.UnsortTable;
Var
  IX : Integer;
BEGIN
  First;
  Randomize;
  for IX := 0 to RecordCOunt do
    BEGIN
      _SwapRecords(IX,Random(RecordCount+1));
    END;
  First;
END;

////////////////////////////////////////
////// Part II:
////// Bookmarks management and movement
////////////////////////////////////////

// ____________________________________________________________________________
// TDBF.InternalGotoBookmark
// II: set the requested bookmark as current record
procedure TDBF.InternalGotoBookmark (Bookmark: Pointer);
var
  ReqBookmark: Integer;
begin
  ReqBookmark := PInteger (Bookmark)^;
//  ShowMessage ('InternalGotoBookmark: ' +
//    IntToStr (ReqBookmark));
  if (ReqBookmark >= 0) and (ReqBookmark < FRecordCount {+ fDeletedCount}) then
    FCurrentRecord := ReqBookmark
  else
    raise eDBFError.Create ('Bookmark ' +
      IntToStr (ReqBookmark) + ' not found');
end;

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

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

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

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

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

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

// ____________________________________________________________________________
// TDBF.InternalLast
// II: Go to a special position after the last record
procedure TDBF.InternalLast;
begin
  EofCrack := FRecordCount {+ fDeletedCount};
  FCurrentRecord := EofCrack;
end;

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

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

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

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

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

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

// ____________________________________________________________________________
// TDBF.InternalInitRecord
// III: Initialize the record (set to zero)
procedure TDBF.InternalInitRecord(Buffer: PChar);
(*var
  Field : TField;
  i : integer;
  FieldOffset : integer;
  S : string; *)
begin
  FillChar(Buffer^, FRecordBufferSize, 32);
(*  for i := 0 to FieldCount-1 do
    begin
      Field := Fields[i];
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          pChar(Buffer+FieldOffset)^ := #0;
        end
      else if Field.DataType = ftFloat then
        begin
          pChar(Buffer+FieldOffset)^ := '0';
          pChar(Buffer+FieldOffset+1)^ := #0;
        end
      else if Field.DataType = ftDate then
        begin
          S := '19900101';
          CopyMemory(PChar(Buffer+FieldOffset),PChar(S),8);
        end
      else if Field.DataType = ftBoolean then
        begin
          pChar(Buffer+FieldOffset)^ := 'F';
        end;
    end; *)
end;

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

// ____________________________________________________________________________
// TDBF.GetRecord
// III: Retrieve data for current, previous, or next record
// (eventually moving to it) and return the status
function TDBF.GetRecord(Buffer: PChar;
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
  Acceptable : Boolean;
begin
  result := grOk;
  if FRecordCount < 1 then
    Result := grEOF
  else
    repeat
      case GetMode of
        gmCurrent :
          begin
            // ShowMessage ('GetRecord Current');
            if (FCurrentRecord >= FRecordCount{+fDeletedCount}) or
                (FCurrentRecord < 0) then
              Result := grError;
          end;
        gmNext :
          begin
            if (fCurrentRecord < (fRecordCount{+fDeletedCount})-1) then
              Inc (FCurrentRecord)
            else
              Result := grEOF;
          end;
        gmPrior :
          begin
           if (fCurrentRecord > 0) then
              Dec(fCurrentRecord)
           else
              Result := grBOF;
          end;
      end;
      // fill record data area of buffer
      if Result = grOK then
        begin
          _ReadRecord(Buffer, fCurrentRecord );
          {FStream.Position := FDataFileHeader.StartData +
          FRecordSize * FCurrentRecord;
          FStream.ReadBuffer (Buffer^, FRecordSize);}
          ClearCalcFields(Buffer);
          GetCalcFields(Buffer);
          with PRecInfo(Buffer + FRecordInfoOffset)^ do
            begin
              BookmarkFlag := bfCurrent;
              Bookmark := FCurrentRecord;
            end;
        end
      else
        if (Result = grError) and DoCheck then
          raise eDBFError.Create('GetRecord: Invalid record');
      Acceptable := pRecordHeader(Buffer)^.DeletedFlag <> '*';
      if Filtered then
        Acceptable := Acceptable and (_ProcessFilter(Buffer));
      if (GetMode=gmCurrent) and Not Acceptable then
        Result := grError;
    until (Result <> grOK) or Acceptable;
  if ((Result=grEOF)or(Result=grBOF)) and Filtered and not (_ProcessFilter(Buffer)) then
    Result := grError;
end;

// ____________________________________________________________________________
// TDBF.InternalPost
// III: Write the current data to the file
procedure TDBF.InternalPost;
begin
  CheckActive;
  if State = dsEdit then
    begin
      // replace data with new data
      {FStream.Position := FDataFileHeader.StartData + (FRecordSize * FCurrentRecord);
      FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
      _WriteRecord (ActiveBuffer, fCurrentRecord);
    end
  else
    begin
      // always append
      InternalLast;
      {FStream.Seek (0, soFromEnd);
      FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
      pRecordHeader(ActiveBuffer)^.DeletedFlag := ' ';
      _AppendRecord(ActiveBuffer);
      Inc (FRecordCount);
    end;
end;

// ____________________________________________________________________________
// TDBF.InternalAddRecord
// III: Add the current data to the file
procedure TDBF.InternalAddRecord(Buffer:Pointer; Append:Boolean);
begin
  // always append
  InternalLast;
  // add record at the end of the file
  {FStream.Seek (0, soFromEnd);}
  pRecordHeader(ActiveBuffer)^.DeletedFlag := ' ';
  _AppendRecord(ActiveBuffer);
  {FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}