fastdbvar.pas

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

    ctDateTime,
    ctReal8:     PCliReal8(FData)^ := StrToFloat(Value);
    ctString,
    ctPString:   begin
                   SetBufferTypeAndSize(FFieldType, Length(Value));
                   Move(Value[1], FData[0], Length(Value)+1);
                   //FPData := @FData;
                 end;
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.ClearValue;
begin
  case FFieldType of
    ctOID..ctReal8, ctAutoInc, ctDateTime:
      SetAsInt64(0);
    ctSubst,
    ctString,
    ctPString,
    ctArrayOfOID..ctArrayOfString:
      SetBufferTypeAndSize(FFieldType, 0);
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetFieldType(Value: TCliVarType);
begin
  if FFieldType <> Value then
    SetBufferTypeAndSize(Value);
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetFieldSize: Integer;
begin
  Result := FDataSize; // Length(FData);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetCapacity(const Value: Integer);
begin
  if Value <> FCapacity then
    begin
      FCapacity := Value;
      SetLength(FData, FCapacity);
      FPData := @FData;
    end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetBufferTypeAndSize(const NewType: TCliVarType;
  const NewSize: Integer; const CopyExact: Boolean);
var n : Integer;
begin
  if CopyExact or IsArrayType(NewType) then
    n := NewSize
  else if NewType in [ctString, ctPString] then
    n := NewSize+1
  else
    n := SizeOfCliType[NewType];

  if (FCapacity <> 0) then
    begin
      if n > FCapacity then
        begin
          SetLength(FData, n);
          FCapacity := n;
          FPData := @FData;
        end
      // Note: if n <= FCapacity then the FData buffer was set by the SetCapacity() handler  
    end
  else
    if FDataSize <> n then
      begin
        SetLength(FData, n);
        FPData := @FData;
      end;

  FDataSize := n;

  if FFieldType <> NewType then
    FFieldType := NewType;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsBoolean(const Value: Boolean);
begin
  SetAsInteger(4, Ord(Value));
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsInteger(const Index, Value: Integer);
begin
  SetAsInt64(Value);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsSingle(const Value: Single);
begin
  SetAsDouble(1, Value);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetFieldSize(const Value: Integer);
begin
  SetBufferTypeAndSize(FFieldType, Value);
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetFieldTypeName: string;
begin
  Result := CliVarTypeAsStr(FFieldType);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetValue(const AValue: Pointer; const Size: Integer;
  const CopyExact: Boolean=False);
begin
  SetBufferTypeAndSize(FFieldType, Size, CopyExact);
  if Size > 0 then
    if CopyExact then
      Move(AValue^, FData[0], Size)
    else
      begin
        if IsArrayType(FFieldType) then begin
          Assert(AValue <> nil, FName + '.SetValue() - Value pointer is nil');
          Move(AValue^, FData[0], Size)
        end else if FFieldType in [ctString, ctPString] then begin
          Assert((Size+1) = FDataSize, Format('%s.SetValue(%d) - Data Size Mismatch. Expected %d bytes', [FName, Size, FDataSize]));
          StrPCopy(PChar(FData), PChar(AValue));
        end else begin
          Assert(Size = FDataSize, Format('%s.SetValue(%d) - Data Size Mismatch. Expected %d bytes', [FName, Size, FDataSize]));
          Move(AValue^, FData[0], Size);
        end;
      end;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetDisplayName: string;
begin
  if FName <> '' then
    Result := Name
  else
    Result := Format('%s[%d]', [ClassName, Index]);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.UnBindFromStatement;
begin
  FBoundToStatement := -1;  // Note: since 0 is a valid statement we initialize this to a negative value
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.BindToStatement(const AStatement: Integer): Boolean;
begin
  Result := FBoundToStatement <> AStatement;
  if Result then
    FBoundToStatement := AStatement;
end;

//---------------------------------------------------------------------------
{function TFieldBufferItem.RequireStringAllocation(const CliType: TCliVarType;
  const NewSize: Integer): Boolean;
begin
  Result := (CliType in [ctPString, ctString]) and (NewSize >= FDataSize);
end;}

//---------------------------------------------------------------------------
procedure TFieldBufferItem.ReadFromStream(Stream: TStream);
var
  n : Integer;
  ft : TCliVarType;
begin
  Stream.Read(ft, SizeOf(TCliVarType));
  Stream.Read(n, SizeOf(Integer));
  if n > 0 then
    begin
      SetLength(FName, n);
      Stream.Read(FName[1], n);
    end
  else
    FName := '';

  Stream.Read(n, SizeOf(Integer));
  SetBufferTypeAndSize(ft, n);
  if n > 0 then
    Stream.Read(FData[0], n);

  n := Length(FDateFormat);
  if n > 0 then
    begin
      SetLength(FDateFormat, n);
      Stream.Read(FDateFormat[1], n);
    end
  else
    FDateFormat := '';
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.ReadFromStream(Stream: TStream; const AJustData: Boolean);
var
  n : Integer;
  ft: TCliVarType;
begin
  if AJustData then
    begin
      Stream.Read(FCapacity, SizeOf(Integer));
      Stream.Read(ft, SizeOf(TCliVarType));
      SetBufferTypeAndSize(ft, n);
      Stream.Read(n, SizeOf(Integer));
      SetLength(FName, n);
      Stream.Read(FName[1], n);
      if n > 0 then
        Stream.Read(FData[0], n);
    end
  else
    ReadFromStream(Stream);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.WriteToStream(Stream: TStream);
var n : Integer;
begin
  Stream.Write(FCapacity, SizeOf(Integer));
  Stream.Write(FFieldType, SizeOf(TCliVarType));
  n := Length(FName);
  Stream.Write(n, SizeOf(Integer));
  if n > 0 then
    Stream.Write(FName[1], Length(FName));
  Stream.Write(FDataSize, SizeOf(Integer));
  if n > 0 then
    Stream.Write(FData[0], FDataSize);
  n := Length(FDateFormat);
  if n > 0 then
    Stream.Write(FDateFormat[1], Length(FDateFormat));
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.WriteToStream(Stream: TStream; const AJustData: Boolean);
var n : Integer;
begin
  if AJustData then
    begin
      Stream.Write(FFieldType, SizeOf(TCliVarType));
      n := FDataSize;
      Stream.Write(n, SizeOf(Integer));
      if n > 0 then
        Stream.Write(FData[0], FDataSize);
    end
  else
    WriteToStream(Stream);
end;

//---------------------------------------------------------------------------
// TFastDbField
//---------------------------------------------------------------------------
procedure TFastDbField.SetFieldFlags(const Value: Integer);
begin
  FIndexType := FieldFlagsToIndexTypes(Value);
end;

//---------------------------------------------------------------------------
function TFastDbField.GetFieldFlags: Integer;
begin
  Result := IndexTypesToFieldFlags(FIndexType);
end;

//---------------------------------------------------------------------------
function TFastDbField.GetArraySize: Integer;
begin
  if IsArrayType(FFieldType) then
    Result := FDataSize div SizeOfCliType[TCliVarType(Ord(FFieldType) - Ord(ctArrayOfOID))]
  else
    Result := 1;
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArraySize(const Value: Integer);
var n, nNew : Integer;
begin
  n    := SizeOfCliType[TCliVarType(Ord(FFieldType) - Ord(ctArrayOfOID))];
  nNew := n * Value;
  if IsArrayType(FFieldType) then
    begin
      if FDataSize <> nNew then
        SetBufferTypeAndSize(FFieldType, nNew);
        //SetLength(FData, nNew);
    end
  else
    raise EFastDbError.Create(cli_unsupported_type);
end;

//---------------------------------------------------------------------------
function TFastDbField.BindToStatement(const AStatement: Integer): Boolean;
var
  n : Integer;
  p : Pointer;
begin
  Result := inherited BindToStatement(AStatement);
  if Result then
    begin
      p := asPointer;
      n := FDataSize;
      if IsArrayType(FFieldType) or (FFieldType in [ctString, ctPString]) then begin
        {$IFDEF CLI_DEBUG}
        TraceDebugProcedure(Format('cli_array_column_ex(%d, "%s", %d, 0x%p, '#10+
                                   '                        (*set)0x%p, (*get)0x%p)', [AStatement, FName, CliTypeToOrd(FieldType), p, @SetFieldColumn, @GetFieldColumn]), True);
        {$ENDIF}
        n := cli_array_column_ex(AStatement, PChar(FName), CliTypeToOrd(FieldType), p, @SetFieldColumn, @GetFieldColumn, Self);
      end else begin
        {$IFDEF CLI_DEBUG}
        TraceDebugProcedure(Format('cli_column(%d, "%s", %d, %d, '#10+
                                   '               (*set)0x%p, (*get)0x%p)', [AStatement, FName, CliTypeToOrd(FieldType), FDataSize, @SetFieldColumn, @GetFieldColumn]), True);
        {$ENDIF}
        n := cli_column(AStatement, PChar(FName), CliTypeToOrd(FieldType), @n, p);
      end;
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('%d', [n]), False);
      {$ENDIF}
      CliCheck(n);
    end;
end;

//---------------------------------------------------------------------------
procedure TFastDbField.Assign(Source: TPersistent);
begin
  if Source is TFastDbField then
    begin
      inherited Assign(Source);
      FRefTable        := TFastDbField(Source).FRefTable;
      FInverseRefField := TFastDbField(Source).FInverseRefField;
      FIndexType       := TFastDbField(Source).FIndexType;
    end
  else
    inherited Assign(Source);
end;
//---------------------------------------------------------------------------
function TFastDbField.GetArrayAsBoolean(Idx: Integer): Boolean;
begin