fastdbvar.pas

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

    cli_asciiz : Result := ctPString;
  else
    Result := TCliVarType(CliOrdType);
  end;
end;

//---------------------------------------------------------------------------
function FieldFlagsToIndexTypes(const FieldFlags: Integer): TIndexTypes;
begin
  Result := [];
  if (FieldFlags and cli_hashed)  > 0             then Include(Result, itHash);
  if (FieldFlags and cli_indexed) > 0             then Include(Result, itTree);
  {$IFDEF GIGABASE}
  if (FieldFlags and cli_case_insensitive) > 0    then Include(Result, itCaseInsensitive);
  if (FieldFlags and cli_unique) > 0              then Include(Result, itUnique);
  if (FieldFlags and cli_optimize_duplicates) > 0 then Include(Result, itOptimizeDuplicates);
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function IndexTypesToFieldFlags(const IndexTypes: TIndexTypes): Integer;
begin
  Result := 0;
  if itHash in IndexTypes               then Result := cli_hashed;
  if itTree in IndexTypes               then Result := Result or cli_indexed;
  {$IFDEF GIGABASE}
  if itCaseInsensitive in IndexTypes    then Result := Result or cli_case_insensitive;
  if itUnique in IndexTypes             then Result := Result or cli_unique;
  if itOptimizeDuplicates in IndexTypes then Result := Result or cli_optimize_duplicates;
  {$ENDIF}
end;

//---------------------------------------------------------------------------
function FastDbFieldToFieldDescriptor(Field: TFastDbField): TCliFieldDescriptor;
begin
  with Result do begin
    FieldType           := CliTypeToOrd(Field.FieldType);
    Flags               := Field.FieldFlags;
    name                := PChar(Field.Name);
    if Field.RefTable = '' then
      refTableName := nil
    else
      refTableName := PChar(Field.RefTable);
    if Field.InverseRefField = '' then
      inverseRefFieldName := nil
    else
      inverseRefFieldName := PChar(Field.InverseRefField);
  end;
end;

//---------------------------------------------------------------------------
function GetValueAsStr(const CliType: TCliVarType; Value: Pointer): string;
begin
  case CliType of
    ctOID          : Result := IntToStr(TCliOid(Value^));
    ctBOOL         : if Byte(Value^) <> 0 then Result := '1' else Result := '0';
    ctInt1         : Result := IntToStr(Byte(Value^));
    ctInt2         : Result := IntToStr(SmallInt(Value^));
    ctAutoInc,
    ctInt4         : Result := IntToStr(TCliInt4(Value^));
    ctInt8         : Result := IntToStr(TCliInt8(Value^));
    ctReal4        : Result := FloatToStr(Single(Value^));
    ctDateTime     : Result := FormatDateTime('mm/dd/yyyy hh:nn:ss', TDateTime(Value^));
    ctReal8        : Result := FloatToStr(Double(Value^));
    ctString       : Result := PChar(Value^);
    ctPString      : Result := PChar(Pointer(Value^)^);
  else
    Result := '';
  end;
end;

//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
function GetFieldColumn(const ColumnType: Integer;
  varPtr: Pointer; var Len: Integer; const ColumnName: PChar;
  const Statement: Integer; const UserData: Pointer): Pointer; cdecl;
var
  fld : TFieldBufferItem absolute UserData;
begin
  Assert(fld <> nil, 'UserData must be assigned a value of TFieldBufferItem object!');
  if Assigned(fld.OnArrayGetValue) then
    Result := Pointer(fld.OnArrayGetValue(fld, varPtr, Len, statement))
  else if IsArrayType(fld.FieldType) then
    begin
      Len    := fld.FieldSize div SizeOfCliType[TCliVarType(Ord(fld.FieldType) - Ord(ctArrayOfOID))];
      Result := fld.asPointer;
    end
  else if fld.FieldType in [ctString, ctPString] then
    begin
      Len    := fld.FieldSize-1;
      Result := fld.asPointer;
    end
  else
    begin
      Len    := fld.FieldSize;
      Result := fld.asPointer;
    end;
end;

//---------------------------------------------------------------------------
function SetFieldColumn(const ColumnType: Integer;
  varPtr: Pointer; Len: Integer; const ColumnName: PChar;
  const Statement: Integer; const SourcePtr: Pointer;
  const UserData: Pointer): Pointer; cdecl;
var
  fld : TFieldBufferItem absolute UserData;
begin
  Assert(fld <> nil, 'UserData must be assigned a value of TFieldBufferItem object!');
  if Assigned(fld.OnArraySetValue) then
    Result := Pointer(fld.OnArraySetValue(fld, varPtr, SourcePtr, Len, statement))
  else if fld.FieldType in [ctString, ctPString] then
    begin
      fld.SetFieldSize(len);
      Result := PPChar(fld.asPointer)^;
    end
  else if IsArrayType(fld.FieldType) then
    if fld.FetchData then
      begin
        fld.SetFieldSize(len*SizeOfCliType[TCliVarType(Ord(fld.FieldType) - Ord(ctArrayOfOID))]);
        //SetValue(varPtr, Len);  // FastDB copies data automatically
        Result := fld.asPointer;
      end
    else
      Result := nil               // FastDB won't fetch a field if we return nil
  else // sanity check
    raise EFastDbError.Create(cli_unsupported_type);
end;

//---------------------------------------------------------------------------
// TFastDbField
//---------------------------------------------------------------------------
constructor TFieldBufferItem.Create(Collection: TCollection);
begin
  inherited;
  FFieldType := ctUnknown;
  FFetchData := True;
  FBoundToStatement := FastDbUnilitializedHandle;  // Note: since 0 is a valid statement we initialize this to a negative value
end;

//---------------------------------------------------------------------------
destructor TFieldBufferItem.Destroy;
begin
  FreeBuffer;
  inherited;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.Assign(Source: TPersistent);
begin
  if Source is TFieldBufferItem then
    begin
      FBoundToStatement := TFieldBufferItem(Source).FBoundToStatement;
      //FBoundToStatement := FastDbUnilitializedHandle;
      CopyTypeAndValue(TFieldBufferItem(Source));
    end
  else
    inherited Assign(Source);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.CopyTypeAndValue(FromField: TFieldBufferItem);
begin
  FName             := FromField.FName;
  //FBoundToStatement := TFieldBufferItem(Source).FBoundToStatement;
  //FBoundToStatement := FastDbUnilitializedHandle;
  FDateFormat       := FromField.FDateFormat;
  FOnArraySetValue  := FromField.FOnArraySetValue;
  FOnArrayGetValue  := FromField.FOnArrayGetValue;

  SetBufferTypeAndSize(FromField.FFieldType, FromField.FieldSize, True);

  SetValue(FromField.FData, FromField.FieldSize, True);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.FreeBuffer;
begin
  FData := nil;
  FDataSize := 0;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsBoolean: Boolean;
begin
  Result := GetAsInt64 <> 0;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsDouble(const Index: Integer): Double;
begin
  case FFieldType of
    ctOID,
    ctInt4:     Result := PCliInt4(FData)^;
    ctBOOL,
    ctInt1:     Result := PByte(FData)^;
    ctInt2:     Result := PCliInt2(FData)^;
    ctInt8:     Result := PCliInt8(FData)^;
    ctReal4:    Result := PCliReal4(FData)^;
    ctDateTime,
    ctReal8:    Result := PCliReal8(FData)^;
    ctString:   begin
                  Assert(FData <> nil, 'String not assigned!');
                  if not TryStrToFloat(PChar(FData), Result) then Result := 0;
                end;
    ctPString:  begin
                  Assert(FPData <> nil, 'String not assigned!');
                  if not TryStrToFloat(PChar(FPData^), Result) then Result := 0;
                end;
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsInt64: Int64;
begin
  case FFieldType of
    ctOID,
    ctInt4:     Result := PCliInt4(FData)^;
    ctBOOL,
    ctInt1:     Result := PByte(FData)^;
    ctInt2:     Result := PCliInt2(FData)^;
    ctInt8:     Result := PCliInt8(FData)^;
    ctReal4:    Result := Trunc(PCliReal4(FData)^);
    ctDateTime,
    ctReal8:    Result := Trunc(PCliReal8(FData)^);
    ctString:   begin
                  Assert(FData <> nil, 'String not assigned!');
                  if not TryStrToInt64(PChar(FData), Result) then Result := 0;
                end;
    ctPString:  begin
                  Assert(FPData <> nil, 'String not assigned!');
                  if not TryStrToInt64(PChar(FPData^), Result) then Result := 0;
                end;
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsInteger(const Index: Integer): Integer;
begin
  Result := GetAsInt64;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsPointer: Pointer;
begin
  if FFieldType in [ctString, ctPString] then
    Result := FPData
  else
    Result := FData;
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsSingle: Single;
begin
  Result := GetAsDouble(1);
end;

//---------------------------------------------------------------------------
function TFieldBufferItem.GetAsString: string;
begin
  case FFieldType of
    ctBOOL:     if GetAsInt64 <> 0 then Result := 'True' else Result := 'False';
    ctOID,
    ctInt8,
    ctInt4,
    ctInt1,
    ctInt2:     Result := IntToStr(GetAsInt64);
    ctDateTime: if FDateFormat <> '' then
                  Result := FormatDateTime(FDateFormat, GetAsDouble(2))
                else
                  Result := FormatDateTime(DATE_FORMAT_STRING, GetAsDouble(2));
    ctReal4,
    ctReal8:    Result := FloatToStr(GetAsDouble(2));
    ctString:   Result := PChar(FData);
    ctPString:  begin
                  if FPData = nil then
                    Result := ''
                  else
                    Result := string(Pointer(FPData^));
                end;
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsDouble(const Index: Integer; const Value: Double);
begin
  case FFieldType of
    ctOID,
    ctInt4:      PCliInt4(FData)^ := Trunc(Value);
    ctBOOL,
    ctInt1:      PByte(FData)^ := Trunc(Value);
    ctInt2:      PCliInt2(FData)^ := Trunc(Value);
    ctInt8:      PCliInt8(FData)^ := Trunc(Value);
    ctReal4:     PCliReal4(FData)^ := Value;
    ctDateTime,
    ctReal8:     PCliReal8(FData)^ := Value;
    ctString,
    ctPString:   SetAsString(FloatToStr(Value));
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsInt64(const Value: Int64);
begin
  case FFieldType of
    ctOID,
    ctInt4:      PCliInt4(FData)^  := Value;
    ctBOOL,
    ctInt1:      PByte(FData)^     := Value;
    ctInt2:      PCliInt2(FData)^  := Value;
    ctInt8:      PCliInt8(FData)^  := Value;
    ctReal4:     PCliReal4(FData)^ := Value;
    ctDateTime,
    ctReal8:     PCliReal8(FData)^ := Value;
    ctString,
    ctPString:   SetAsString(FloatToStr(Value));
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferItem.SetAsString(const Value: string);
var s : string;
begin
  case FFieldType of
    ctOID,
    ctInt4:      PCliInt4(FData)^  := StrToInt(Value);
    ctInt1:      PByte(FData)^     := StrToInt(Value);
    ctInt2:      PCliInt2(FData)^  := StrToInt(Value);
    ctInt8:      PCliInt8(FData)^  := StrToInt(Value);
    ctBOOL:      begin
                   s := Trim(Value); if s <> '' then s := UpCase(s[1]) else s := ' ';
                   PByte(FData)^ := Ord(s[1] in ['T', 'Y', '1']);
                 end;
    ctReal4:     PCliReal4(FData)^ := StrToFloat(Value);