fastdbvar.pas

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

  Assert((Idx >= 0) and (Idx < ArraySize));
  Result := Byte(TCliBoolArray(FData)[Idx]) <> 0;
end;

//---------------------------------------------------------------------------
function TFastDbField.GetArrayAsInteger(Idx: Integer; Index: Integer): Integer;
begin
  Result := GetArrayAsInt64(Idx);
end;

//---------------------------------------------------------------------------
function TFastDbField.GetArrayAsInt64(Idx: Integer): TCliInt8;
begin
  Assert((Idx >= 0) and (Idx < ArraySize), Format('Array index out of bounds (%d/%d)!', [Idx, ArraySize]));
  case FFieldType of
    ctArrayOfOID,
    ctArrayOfInt4:    Result := TCliInt4Array(FData)[Idx];
    ctArrayOfBool,
    ctArrayOfInt1:    Result := Byte(TCliInt1Array(FData)[Idx]);
    ctArrayOfInt2:    Result := TCliInt2Array(FData)[Idx];
    ctArrayOfInt8:    Result := TCliInt8Array(FData)[Idx];
    ctArrayOfReal4:   Result := Trunc(TCliReal4Array(FData)[Idx]);
    ctArrayOfReal8:   Result := Trunc(TCliReal8Array(FData)[Idx]);
    ctArrayOfString:  begin
                        Assert(PChar(TCliInt4Array(FData)[Idx]) <> nil, 'String not assigned!');
                        if not TryStrToInt64(PChar(TCliInt4Array(FData)[Idx]), 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 TFastDbField.GetArrayAsSingle(Idx: Integer): Single;
begin
  Result := GetArrayAsDouble(1, Idx);
end;

//---------------------------------------------------------------------------
function TFastDbField.GetArrayAsDouble(Idx: Integer; Index: Integer): Double;
begin
  Assert((Index >= 0) and (Index < ArraySize), 'Array index out of bounds!');
  case FFieldType of
    ctArrayOfOID,
    ctArrayOfInt4:    Result := TCliInt4Array(FData)[Index];
    ctArrayOfBool,
    ctArrayOfInt1:    Result := Byte(TCliInt1Array(FData)[Index]);
    ctArrayOfInt2:    Result := TCliInt2Array(FData)[Index];
    ctArrayOfInt8:    Result := TCliInt8Array(FData)[Index];
    ctArrayOfReal4:   Result := TCliReal4Array(FData)[Index];
    ctArrayOfReal8:   Result := TCliReal8Array(FData)[Index];
    ctArrayOfString:  begin
                        Assert(PChar(TCliInt4Array(FData)[Index]) <> nil, 'String not assigned!');
                        if not TryStrToFloat(PChar(TCliInt4Array(FData)[Index]), 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 TFastDbField.GetArrayAsString(Idx: Integer): string;
begin
  Assert((Idx >= 0) and (Idx < ArraySize), 'Array index out of bounds!');
  case FFieldType of
    ctArrayOfBool:    if GetArrayAsInt64(Idx) <> 0 then Result := 'True' else Result := 'False';
    ctArrayOfOID,
    ctArrayOfInt1,
    ctArrayOfInt2,
    ctArrayOfInt4,
    ctArrayOfInt8:    Result := IntToStr(GetArrayAsInt64(Idx));
    ctArrayOfReal4,
    ctArrayOfReal8:   Result := FloatToStr(GetArrayAsDouble(1, Idx));
    ctArrayOfString:  Result := PChar(TCliInt4Array(FData)[Idx]);  //!!! Needs testing!
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsBoolean(Idx: Integer; const Value: Boolean);
begin
  SetArrayAsInteger(Idx, 4, Ord(Value));
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsDouble(Idx: Integer; Index: Integer; const Value: Double);
begin
  Assert((Idx >= 0) and (Idx < ArraySize), 'Array index out of bounds!');
  case FFieldType of
    ctArrayOfOID,
    ctArrayOfInt4:   TCliInt4Array(FData)[Idx] := Trunc(Value);
    ctArrayOfBool,
    ctArrayOfInt1:   Byte(TCliInt1Array(FData)[Idx])  := Trunc(Value);
    ctArrayOfInt2:   TCliInt2Array(FData)[Idx]  := Trunc(Value);
    ctArrayOfInt8:   TCliInt8Array(FData)[Idx]  := Trunc(Value);
    ctArrayOfReal4:  TCliReal4Array(FData)[Idx] := Value;
    ctArrayOfReal8:  TCliReal8Array(FData)[Idx] := Value;
    ctArrayOfString: SetArrayAsString(Idx, FloatToStr(Value));
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsInt64(Idx: Integer; const Value: TCliInt8);
begin
  Assert((Idx >= 0) and (Idx < ArraySize), 'Array index out of bounds!');
  case FFieldType of
    ctArrayOfOID,
    ctArrayOfInt4:   Integer(TCliInt4Array(FData)[Idx])  := Value;
    ctArrayOfBool,
    ctArrayOfInt1:   Byte(TCliInt1Array(FData)[Idx])  := Value;
    ctArrayOfInt2:   TCliInt2Array(FData)[Idx]  := Value;
    ctArrayOfInt8:   TCliInt8Array(FData)[Idx]  := Value;
    ctArrayOfReal4:  TCliReal4Array(FData)[Idx] := Value;
    ctArrayOfReal8:  TCliReal8Array(FData)[Idx] := Value;
    ctArrayOfString: SetArrayAsString(Idx, IntToStr(Value));
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsInteger(Idx: Integer; Index: Integer; const Value: Integer);
begin
  SetArrayAsInt64(Idx, Value);
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsSingle(Idx: Integer; const Value: Single);
begin
  SetArrayAsDouble(Idx, 1, Value);
end;

//---------------------------------------------------------------------------
procedure TFastDbField.SetArrayAsString(Idx: Integer; const Value: string);
var s : string;
begin
  Assert((Idx >= 0) and (Idx < ArraySize), 'Array index out of bounds!');
  case FFieldType of
    ctArrayOfOID,
    ctArrayOfInt4:      TCliInt4Array(FData)[Idx]  := StrToInt(Value);
    ctArrayOfBool:      begin
                          s := Trim(Value); if s <> '' then s := UpCase(s[1]) else s := ' ';
                          Byte(TCliInt1Array(FData)[Idx]) := Ord(s[1] in ['T', 'Y', '1']);
                        end;
    ctArrayOfInt1:      Byte(TCliInt1Array(FData)[Idx])  := StrToInt(Value);
    ctArrayOfInt2:      TCliInt2Array(FData)[Idx]  := StrToInt(Value);
    ctArrayOfInt8:      TCliInt8Array(FData)[Idx]  := StrToInt(Value);
    ctArrayOfReal4:     TCliReal4Array(FData)[Idx] := StrToFloat(Value);
    ctArrayOfReal8:     TCliReal8Array(FData)[Idx] := StrToFloat(Value);
    ctArrayOfString:    TCliInt4Array(FData)[Idx]  := Integer(PChar(Value));  //!!! Needs testing!
  else
    raise EFastDbError.Create(cli_unsupported_type, Format('Field[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
  end;
end;

//---------------------------------------------------------------------------
// TFastDbVariable
//---------------------------------------------------------------------------
function TFastDbVariable.DisplayString(AQuery: TObject): string;
begin
  Result := CliVarTypeAsStr(FieldType);
end;

//---------------------------------------------------------------------------
function TFastDbVariable.GetSubstitudeValue: string;
begin
  Result := GetValueAsStr(FFieldType, asPointer);
end;

//---------------------------------------------------------------------------
procedure TFastDbVariable.SetAsString(const Value: string);
var sOld : string;
begin
  sOld := GetAsString;
  inherited;
  // Notify the query that SQL changed.
  if (FFieldType = ctSubst) and (Value <> sOld)
     and (Collection <> nil)
     and (Collection.Owner <> nil)
     and (Collection.Owner is TFastDbQuery) then
    TFastDbQuery(Collection.Owner).SqlChanged := True;
end;

//---------------------------------------------------------------------------
function TFastDbVariable.BindToStatement(const AStatement: Integer): Boolean;
var rc : Integer;
begin
  Result := inherited BindToStatement(AStatement);
  if Result then
    begin
      if IsArrayType(FFieldType) then
        raise EFastDbError.Create(cli_unsupported_type, Format('Variable[%s] %s', [FName, GetEnumName(TypeInfo(TCliVarType), Ord(FieldType))]));
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('cli_parameter(%d, "%s", %d, 0x%p)', [AStatement, PARAM_CHAR+FName, CliTypeToOrd(FieldType), asPointer]), True);
      {$ENDIF}
      rc := cli_parameter(AStatement, PChar(PARAM_CHAR+FName), CliTypeToOrd(FFieldType), asPointer);
      {$IFDEF CLI_DEBUG}
      TraceDebugProcedure(Format('%d', [rc]), False);
      {$ENDIF}
      CliCheck(rc, 'cli_parameter failed');
    end;
end;

//---------------------------------------------------------------------------
// TDataCollection
//---------------------------------------------------------------------------
function TFieldBufferCollection.Add(const AName: string; AType: TCliVarType): TFieldBufferItem;
var i : Integer;
begin
  for i:=0 to Count-1 do
    with TFieldBufferItem(Items[i]) do
      if StrIComp(PChar(FName), PChar(AName)) = 0 then   // Note: StrIComp() works faster than SameText()
        raise EFastDbError.Create(cli_item_already_defined);
  Result := TFieldBufferItem(inherited Add);
  Result.FName := AName;
  Result.FieldType := AType;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferCollection.Delete(const AName: string);
var i : Integer;
begin
  for i:=0 to Count-1 do
    with TFieldBufferItem(Items[i]) do
      if StrIComp(PChar(FName), PChar(AName)) = 0 then   // Note: StrIComp() works faster than SameText()
        begin
          Free;
          exit;
        end;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferCollection.UnBindFromStatement;
var i : Integer;
begin
  for i:=0 to Count-1 do
    TFieldBufferItem(Items[i]).UnBindFromStatement;
end;

//---------------------------------------------------------------------------
function TFieldBufferCollection.asText: string;
var i : Integer;
begin
  Result := '';
  for i:=0 to Count-1 do
    with TFieldBufferItem(Items[i]) do
      if not IsArrayType(FFieldType) then
        Result := Format('%s%s=%s'+EOL, [Result, FName, asString]);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferCollection.ClearValues;
var i : Integer;
begin
  for i:=0 to Count-1 do
    TFieldBufferItem(Items[i]).ClearValue;
end;

//---------------------------------------------------------------------------
procedure TFieldBufferCollection.ReadFromStream(Stream: TStream);
var i : Integer;
begin
  for i:=0 to Count-1 do
    TFieldBufferItem(Items[i]).ReadFromStream(Stream);
end;

//---------------------------------------------------------------------------
procedure TFieldBufferCollection.WriteToStream(Stream: TStream);
var i : Integer;
begin
  for i:=0 to Count-1 do
    TFieldBufferItem(Items[i]).WriteToStream(Stream);
end;

//---------------------------------------------------------------------------
// TFastDbFields
//---------------------------------------------------------------------------
constructor TFastDbFields.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TFastDbField);
end;

//---------------------------------------------------------------------------
function TFastDbFields.Add(const AName: string; const AType: TCliVarType;
  const AIndexType: TIndexTypes; const ARefTable,
  AInverseRefField: string): TFastDbField;
begin
  Result := TFastDbField(inherited Add(AName, AType));
  Result.IndexType  := AIndexType;
  Result.RefTable   := ARefTable;
  Result.InverseRefField := AInverseRefField;
end;

//---------------------------------------------------------------------------
function TFastDbFields.GetField(Index: Integer): TFastDbField;
begin
  Result := TFastDbField(Items[Index]);
end;

//---------------------------------------------------------------------------
procedure TFastDbFields.SetField(Index: Integer; const Value: TFastDbField);
begin
  TFastDbField(Items[Index]).Assign(Value);
end;

//---------------------------------------------------------------------------
// TFastDbVariables
//---------------------------------------------------------------------------
constructor TFastDbVariables.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TFastDbVariable);
end;

//---------------------------------------------------------------------------
function TFastDbVariables.Add(const AName: string;
  const AType: TCliVarType; AValue: Pointer=nil): TFastDbVariable;
begin
  if AType in [ctArrayOfOID .. ctArrayOfString, ctUnknown] then
    raise EFastDbError.Create(cli_unsupported_type);
  Result := TFastDbVariable(inherited Add(AName, AType));
  Result.Name := AName;
  Result.FieldType := AType;
  if AValue <> nil then
    Result.SetValue(AValue, Result.FieldSize);
end;

//---------------------------------------------------------------------------
function TFastDbVariables.GetVariable(Index: Integer): TFastDbVariable;
begin
  Result := TFastDbVariable(Items[Index]);
end;

//---------------------------------------------------------------------------
procedure TFastDbVariables.SetVariable(Index: Integer; const Value: TFastDbVariable);
begin
  TFastDbVariable(Items[Index]).Assign(Value);
end;

end.