memtableeh.pas

EhLib v4.3.21 (完整源码) Ehlib 是著名的数据库连接控制

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.IndexToBuffer(I: Integer): TRecordBuffer;
begin
  Result := TRecordBuffer(I + 1);
end;
{$ELSE}
function TCustomMemTableEh.IndexToBuffer(I: Integer): {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
begin
{$IFDEF CIL}
  Result := TRecordBuffer(I + 1);
{$ELSE}
  Result := PChar(I + 1);
{$ENDIF}
end;
{$ENDIF}

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.BufferToIndex(Buf: TRecordBuffer): Integer;
{$ELSE}
function TCustomMemTableEh.BufferToIndex(Buf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): Integer;
{$ENDIF}
begin
  Result := Integer(Buf) - 1; // Buf is off by one so that nil (0) represents an invalid buffer
end;

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.BufferToRecBuf(Buf: TRecordBuffer): TRecBuf;
{$ELSE}
function TCustomMemTableEh.BufferToRecBuf(Buf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): TRecBuf;
{$ENDIF}
begin
  Result := TRecBuf(FRecordCache[BufferToIndex(Buf)]);
end;

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.AllocRecordBuffer: TRecordBuffer;
{$ELSE}
function TCustomMemTableEh.AllocRecordBuffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
{$ENDIF}

  procedure ClearBuffer(RecBuf: TRecBuf);
//  var
//    I: Integer;
  begin
    RecBuf.SetLength(FieldCount);
//    SetLength(RecBuf.Values, FieldCount);
//    for I := 0 to Fields.Count - 1 do
//      RecBuf.Values[I] := Null;
  end;

{$IFDEF EH_LIB_12}
  function InitializeBuffer(I: Integer): TRecordBuffer;
{$ELSE}
  function InitializeBuffer(I: Integer): {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
{$ENDIF}
  begin
    TRecBuf(FRecordCache[I]).InUse := True;
    TRecBuf(FRecordCache[I]).RecordNumber := -2;
    ClearBuffer(TRecBuf(FRecordCache[I]));
    Result := IndexToBuffer(I);
  end;

var
  RecBuf: TRecBuf;
  I, NewIndex: Integer;
begin
  for I := 0 to FRecordCache.Count - 1 do
    if not TRecBuf(FRecordCache[I]).InUse then
    begin
      Result := InitializeBuffer(I);
      Exit;
    end;

  RecBuf := TRecBuf.Create;
  ClearBuffer(RecBuf);
  RecBuf.RecordStatus := -2;
  RecBuf.RecView := nil;
  RecBuf.MemRec := nil;
//  RecBuf.RecordsView := nil;
  NewIndex := FRecordCache.Add(RecBuf);
  Result := InitializeBuffer(NewIndex);
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.FreeRecordBuffer(var Buffer: TRecordBuffer);
{$ELSE}
procedure TCustomMemTableEh.FreeRecordBuffer(var Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
{$ENDIF}
var
//  RecBuf: TRecBuf;
  I{, J}: Integer;
begin

  I := BufferToIndex(Buffer);
  if (I = FRecordCache.Count - 1) and (BufferCount < FRecordCache.Count - 2) then
  begin
//    FRecordCache[FRecordCache.Count-1].Free;
    FRecordCache.Count := I;
  end else
  begin
    TRecBuf(FRecordCache[I]).InUse := False;
    TRecBuf(FRecordCache[I]).RecordNumber := -1;
//    for J := 0 to Length(TRecBuf(FRecordCache[I]).Values) - 1 do
//      TRecBuf(FRecordCache[I]).Values[J] := Null;
    TRecBuf(FRecordCache[I]).Clear;
    TRecBuf(FRecordCache[I]).RecView := nil;
    TRecBuf(FRecordCache[I]).MemRec := nil;
    TRecBuf(FRecordCache[I]).UseMemRec := False;
//    TRecBuf(FRecordCache[I]).RecordsView := nil;
  end;

{  RecBuf := PRecBuf(Buffer);
  SetLength(RecBuf^.Values, 0);
  Dispose(RecBuf);}
  Buffer := nil;
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.ClearCalcFields(Buffer: TRecordBuffer);
{$ELSE}
procedure TCustomMemTableEh.ClearCalcFields(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
{$ENDIF}
var
  I: Integer;
begin
  if CalcFieldsSize > 0 then
    for I := 0 to Fields.Count - 1 do
      with Fields[I] do
        if FieldKind in [fkCalculated, fkLookup] then
//          BufferToRecBuf(Buffer).Values[Index] := Null;
          BufferToRecBuf(Buffer).Value[Fields[I]] := Null;
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.InternalInitRecord(Buffer: TRecordBuffer);
{$ELSE}
procedure TCustomMemTableEh.InternalInitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
{$ENDIF}
//var
//  I: Integer;
begin
//  for I := 0 to Fields.Count - 1 do
//    BufferToRecBuf(Buffer).Values[I] := Null;
  BufferToRecBuf(Buffer).Clear;
  BufferToRecBuf(Buffer).RecView := nil;
  BufferToRecBuf(Buffer).MemRec := nil;
  BufferToRecBuf(Buffer).UseMemRec := False;
//  BufferToRecBuf(Buffer).RecordsView := Nil;
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.InitRecord(Buffer: TRecordBuffer);
{$ELSE}
procedure TCustomMemTableEh.InitRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
{$ENDIF}
begin
  inherited InitRecord(Buffer);

  with BufferToRecBuf(Buffer) do
  begin
    Bookmark := Low(Integer);
    BookmarkFlag := bfInserted;
//    RecordStatus := 0;
    RecordNumber := -1;
  end;
end;

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.GetCurrentRecord(Buffer: TRecordBuffer): Boolean;
{$ELSE}
function TCustomMemTableEh.GetCurrentRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}): Boolean;
{$ENDIF}
begin
  Result := False;
{  if not IsEmpty and (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then
  begin
    UpdateCursorPos;
    if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
    begin
      Move(FRecords[FRecordPos]^, Buffer^, FDataRecordSize);
      Result := True;
    end;
  end;
}
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.RecordToBuffer(MemRec: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh;
  Buffer: TRecordBuffer; RecIndex: Integer);
{$ELSE}
procedure TCustomMemTableEh.RecordToBuffer(MemRec: TMemoryRecordEh;
  DataValueVersion: TDataValueVersionEh;
  Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF}; RecIndex: Integer);
{$ENDIF}
//var
//  i: Integer;
begin

  with BufferToRecBuf(Buffer) do
  begin
    Bookmark := RecIndex + 1; //FRecordsView.ViewRecord[FRecordPos].ID;
    RecordNumber := RecIndex;
    BookmarkFlag := bfCurrent;
//    RecordStatus := 0; //Recordset.Status;
  end;
  BufferToRecBuf(Buffer).MemRec := MemRec;

  // Don't need assign data values
  // Will do in on first SetFieldData
//  if GlobalUseMemRec then
    BufferToRecBuf(Buffer).UseMemRec := True;
//  else
//    for i := 0 to FieldCount-1 do
//      if Fields[i].FieldNo > 0 then
//        BufferToRecBuf(Buffer).Values[Fields[i].Index] := MemRec.Value[Fields[i].FieldNo-1, dvvValueEh];

  GetCalcFields(Buffer);
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.SetMemoryRecordData(Buffer: TRecordBuffer;
  Rec: TMemoryRecordEh);
{$ELSE}
procedure TCustomMemTableEh.SetMemoryRecordData(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  Rec: TMemoryRecordEh);
{$ENDIF}
var
  i: Integer;
begin
  if State = dsFilter then
    Error(SNotEditing);
  for i := 0 to FieldCount-1 do
    if Fields[i].FieldNo > 0 then
      Rec.Value[Fields[i].FieldNo-1, dvvValueEh] :=
//        BufferToRecBuf(Buffer).Values[Fields[i].Index];
        BufferToRecBuf(Buffer).Value[Fields[i]];
end;

{$IFDEF EH_LIB_12}
procedure TCustomMemTableEh.CopyBuffer(FromBuf, ToBuf: TRecordBuffer);
{$ELSE}
procedure TCustomMemTableEh.CopyBuffer(FromBuf, ToBuf: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF});
{$ENDIF}
var
  i: Integer;
  FromRecBuf, ToRecBuf: TRecBuf;
begin
  FromRecBuf := BufferToRecBuf(FromBuf);
  ToRecBuf := BufferToRecBuf(ToBuf);
//  BufferToRecBuf(Buffer).RecInfo := BufferToRecBuf(Buffer).RecInfo;
  ToRecBuf.Bookmark := FromRecBuf.Bookmark;
  ToRecBuf.BookmarkFlag := FromRecBuf.BookmarkFlag;
  ToRecBuf.RecordStatus := FromRecBuf.RecordStatus;
  ToRecBuf.RecordNumber := FromRecBuf.RecordNumber;
  ToRecBuf.NewTreeNodeExpanded := FromRecBuf.NewTreeNodeExpanded;
  ToRecBuf.NewTreeNodeHasChildren := FromRecBuf.NewTreeNodeHasChildren;
  ToRecBuf.RecView := FromRecBuf.RecView;
  ToRecBuf.MemRec := FromRecBuf.MemRec;
//  ToRecBuf.RecordsView := FromRecBuf.RecordsView;

//  SetLength(ToRecBuf.Values, Length(FromRecBuf.Values));
  ToRecBuf.SetLength(Length(FromRecBuf.Values));
  for i := 0 to Length(ToRecBuf.Values)-1 do
    ToRecBuf.Values[i] := FromRecBuf.Values[i];

  ToRecBuf.UseMemRec := FromRecBuf.UseMemRec;
end;

procedure TCustomMemTableEh.VarValueToFieldValue(VarValue: Variant;
  FieldBuffer: {$IFDEF CIL}TObject{$ELSE}Pointer{$ENDIF}; Field: TField);
//var
//  FieldValBuf: PFieldValBuf;
begin
//  FieldValBuf := PFieldValBuf(FieldBuffer);
//  FieldValBuf.VarValue := VarValue;
end;

function TCustomMemTableEh.FieldValueToVarValue(
  FieldBuffer: {$IFDEF CIL}TObject{$ELSE}Pointer{$ENDIF}; Field: TField): Variant;
//var
//  FieldValBuf: PFieldValBuf;
begin
//  FieldValBuf := PFieldValBuf(FieldBuffer);
//  Result := FieldValBuf^.VarValue;
  Result := Unassigned;
end;

{$IFDEF EH_LIB_12}
function TCustomMemTableEh.GetRecord(Buffer: TRecordBuffer;
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
{$ELSE}
function TCustomMemTableEh.GetRecord(Buffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
{$ENDIF}
begin
  Result := grOk;
//  if (BufferToRecBuf(Buffer).BookmarkFlag = bfCurrent) and (State in dsEditModes) then
//    Exit;
  case GetMode of
    gmPrior:
      if FRecordPos <= 0 then
      begin
        Result := grBOF;
        FRecordPos := -1;
        FInstantReadCurRowNum := 0;
      end else
        Dec(FRecordPos);
    gmCurrent:
      if (FRecordPos < 0) or (FRecordPos >= RecordsView.ViewItemsCount) then
        Result := grError;
    gmNext:
      begin
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
        begin
          BeginRecordsViewUpdate;
          try
            if FetchAllOnOpen
              then DoFetchRecords(-1)
              else DoFetchRecords(1);
          finally
            EndRecordsViewUpdate(False);
          end;
        end;
        if FRecordPos >= FRecordsView.ViewItemsCount - 1 then
        begin
          FRecordPos := FRecordsView.ViewItemsCount;
          Result := grEOF
        end else
          Inc(FRecordPos);
      end;
  end;
  if FRecordPos >= 0 then
    FInstantReadCurRowNum := FRecordPos;
  if Result = grOk then
  begin
    RecordToBuffer(FRecordsView.ViewRecord[FRecordPos], dvvValueEh, Buffer, FRecordPos);
//    BufferToRecBuf(Buffer).Bookmark := FRecordPos + 1;//FRecordsView.ViewRecord[FRecordPos].ID;
//    BufferToRecBuf(Buffer).RecordNumber := FRecordPos;
    BufferToRecBuf(Buffer).MemRec := FRecordsView.ViewRecord[FRecordPos];
//    BufferToRecBuf(Buffer).RecordsView := FRecordsView;
    if FRecordsView.ViewAsTreeList
      then BufferToRecBuf(Buffer).RecView := FRecordsView.MemoryTreeList.VisibleItem[FRecordPos]
      else BufferToRecBuf(Buffer).RecView := nil;
  end else if (Result = grError) and DoCheck then
    Error(SMemNoRecords);
end;

procedure TCustomMemTableEh.Resync(Mode: TResyncMode);
begin
  if FRecordsViewUpdating = 0
    then inherited Resync(Mode)
    else FRecordsViewUpdated := True;
end;

function TCustomMemTableEh.GetRecordSize: Word;
begin
  Result := FRecBufSize;
end;

function TCustomMemTableEh.GetActiveRecBuf(var RecBuf: TRecBuf; IsForWrite: Boolean): Boolean;

{$IFDEF EH_LIB_12}
  function GetOldValuesBuffer: TRecordBuffer;
{$ELSE}
  function GetOldValuesBuffer: {$IFDEF CIL}TRecordBuffer{$ELSE}PChar{$ENDIF};