absvariant.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

unit ABSVariant;

{$I ABSVer.inc}

interface

uses SysUtils, Classes,

      Windows, Math,

// AbsoluteDatabase units

{$IFNDEF D6H}
     ABSD4Routines,
{$ENDIF}
     {$IFDEF DEBUG_LOG}
     ABSDebug,
     {$ENDIF}
     ABSCompression,
     ABSTypes,
     ABSTypesRoutines,
     ABSConst,
     ABSConverts,
     ABSMemory,
     ABSExcept;

type

 TABSVariant = class(TObject)
  private
   FDataType:     TABSBaseFieldType;    // type of data
   FDataSize:     Integer;              // size of data value
   FPData:        PChar;                // Binary data representation
   FIsDataLinked: ByteBool;             // freemem required?
   FIsNull:       ByteBool;             // Abstract Boolean Flag
  public
   procedure LoadFromStream(Stream: TStream);
   procedure SaveToStream(Stream: TStream);
   // Constructor
   constructor Create(DataType: TABSBaseFieldType = bftUnknown);
   // Destructor
   destructor Destroy; override;
   // SetNull
   procedure SetNull(DataType: TABSBaseFieldType = bftUnknown);
   // Free Buffer
   procedure Clear(DataType: TABSBaseFieldType = bftUnknown);
   // Assign data from source (or make link to Source.Data)
   procedure Assign(Source: TABSVariant; CopyDataFlag: boolean = true);
   // Set Data (or make link to Data)
   procedure SetData(Buffer: Pointer; Size: Integer;
                     DataType: TABSBaseFieldType;
                     CopyDataFlag: boolean = true);
   // Copy Data to Address
   function CopyDataToAddress(Buffer: Pointer; MaxSize: Integer = -1): boolean;
   // Cast to new data type
   procedure Cast(NewDataType: TABSBaseFieldType);
   // return true if DataType is numeric
   function IsNumericDataType: Boolean;
   // return true if DataType is String
   function IsStringDataType: Boolean;
   // return true if DataType is WideString
   function IsWideStringDataType: Boolean;
   // return true if DataType is BLOB
   function IsBlobDataType: Boolean;
   // return true if DataType is Time, Date, DateTime
   function IsDateTimeDataType: Boolean;

   // return Length of String or -1 (if not IsStringType)
   function StrLen: Integer;

   // data := -data ( if not number then raise)
   procedure InvertValue;
   // data := data + value
   procedure Add(Value: TABSVariant);
   // data := data - value
   procedure Sub(Value: TABSVariant);
   // data := data * value
   procedure Mul(Value: TABSVariant);
   // data := data / value
   procedure Division(Value: TABSVariant);

   // Compare with another Variants
   function Compare(
                    Value: TABSVariant;
                    TrueFalseNullLogic: boolean = True;
                    CaseInsensitive: boolean = True;
                    PartialKey: boolean = False
                   ): TABSCompareResult;
  private
   // Set Data Type
   procedure SetDataType(DataType: TABSBaseFieldType);
   // CastResultToType
   procedure CastResultToType(NewDataType: TABSBaseFieldType; out Result);
   // Cast value to empty FPData
   procedure CastAndSetData(const Value; ValueType: TABSBaseFieldType);
   // raise EABSException if FPData = nil
   procedure CheckDataForNull;

  private
   // return (FPData = nil)
   function GetIsNull: Boolean;

   // Set typed Data to Variant
   procedure SetDataValue(const value; ValueType: TABSBaseFieldType);
   // Set typed Data from Variant
   procedure GetDataValue(out Value; ValueType: TABSBaseFieldType);

   // Set Data for Signed Int8 (Shortint)
   procedure SetDataAsSignedInt8(Value: Shortint);
   // Get Data for Signed Int8 (Shortint)
   function  GetDataAsSignedInt8: Shortint;

   // Set Data for Signed Int16 (Smallint)
   procedure SetDataAsSignedInt16(Value: Smallint);
   // Get Data for Signed Int16 (Smallint)
   function  GetDataAsSignedInt16: Smallint;

   // Set Data for Signed Int32 (Integer)
   procedure SetDataAsSignedInt32(Value: Integer);
   // Get Data for Signed Int32 (Integer)
   function  GetDataAsSignedInt32: Integer;

   // Set Data for Signed Int64 (Int64)
   procedure SetDataAsSignedInt64(Value: Int64);
   // Get Data for Signed Int64 (Int64)
   function  GetDataAsSignedInt64: Int64;

   // Set Data for Unsigned Int8 (Byte)
   procedure SetDataAsUnsignedInt8(Value: Byte);
   // Get Data for Unsigned Int8 (Byte)
   function  GetDataAsUnsignedInt8: Byte;

   // Set Data for Unsigned Int16 (Word)
   procedure SetDataAsUnsignedInt16(Value: Word);
   // Get Data for Unsigned Int16 (Word)
   function  GetDataAsUnsignedInt16: Word;

   // Set Data for Unsigned Int32 (Cardinal)
   procedure SetDataAsUnsignedInt32(Value: Cardinal);
   // Get Data for Unsigned Int32 (Cardinal)
   function  GetDataAsUnsignedInt32: Cardinal;


   // Set Data for Char, Varchar (String)
   procedure SetDataAsString(Value: String);
   // Get Data as String
   function  GetDataAsString: String;

   // Set Data for WideChar, WideVarchar (WideString)
   procedure SetDataAsWideString(Value: WideString);
   // Get Data as WideString
   function  GetDataAsWideString: WideString;


   // Set Data for Single
   procedure SetDataAsSingle(Value: Single);
   // Get Data for Single
   function  GetDataAsSingle: Single;

   // Set Data for Double
   procedure SetDataAsDouble(Value: Double);
   // Get Data for Double
   function  GetDataAsDouble: Double;

   // Set Data for Extended
   procedure SetDataAsExtended(Value: Extended);
   // Get Data for Extended
   function  GetDataAsExtended: Extended;


   // Set Data for ABSDate
   procedure SetDataAsABSDate(Value: TABSDate);
   // Get Data for ABSDate
   function  GetDataAsABSDate: TABSDate;
   // Set Data for TDate
   procedure SetDataAsTDate(Value: TDateTime);
   // Get Data for TDate
   function  GetDataAsTDate: TDateTime;


   // Set Data for ABSTime
   procedure SetDataAsABSTime(Value: TABSTime);
   // Get Data for ABSTime
   function  GetDataAsABSTime: TABSTime;
   // Set Data for TTime
   procedure SetDataAsTTime(Value: TDateTime);
   // Get Data for TTime
   function  GetDataAsTTime: TDateTime;

   // Set Data for ABSDateTime
   procedure SetDataAsABSDateTime(Value: TABSDateTime);
   // Get Data for ABSDateTime
   function  GetDataAsABSDateTime: TABSDateTime;
   // Set Data for TDateTime
   procedure SetDataAsTDateTime(Value: TDateTime);
   // Get Data for TDateTime
   function  GetDataAsTDateTime: TDateTime;

   // Set Data for Boolean
   procedure SetDataAsBoolean(Value: TABSLogical);
   // Get Data for Boolean
   function  GetDataAsBoolean: TABSLogical;


   // Set Data for Currency
   procedure SetDataAsCurrency(Value: TABSCurrency);
   // Get Data for Currency
   function  GetDataAsCurrency: TABSCurrency;

   // Set Data from Borland Variant type
   procedure SetDataAsVariant(Value: Variant);
   // Get Data to Borland Variant type
   function GetDataAsVariant: Variant;

  public
   property DataType: TABSBaseFieldType read FDataType write SetDataType;
   property DataSize: Integer read FDataSize;
   property IsNull: Boolean read GetIsNull;
   property pData: PChar read FPData;
   property IsDataLinked: ByteBool read FIsDataLinked;
  public
   property AsShortint: Shortint      read GetDataAsSignedInt8    write SetDataAsSignedInt8;
   property AsSmallint: Smallint      read GetDataAsSignedInt16   write SetDataAsSignedInt16;
   property AsInteger: Integer        read GetDataAsSignedInt32   write SetDataAsSignedInt32;
   property AsInt64: Int64            read GetDataAsSignedInt64   write SetDataAsSignedInt64;
   property AsByte: Byte              read GetDataAsUnsignedInt8  write SetDataAsUnsignedInt8;
   property AsWord: Word              read GetDataAsUnsignedInt16 write SetDataAsUnsignedInt16;
   property AsCardinal: Cardinal      read GetDataAsUnsignedInt32 write SetDataAsUnsignedInt32;
   property AsLongWord: Cardinal      read GetDataAsUnsignedInt32 write SetDataAsUnsignedInt32;

   property AsSingle: Single          read GetDataAsSingle        write SetDataAsSingle;
   property AsDouble: Double          read GetDataAsDouble        write SetDataAsDouble;
   property AsExtended: Extended      read GetDataAsExtended      write SetDataAsExtended;

   property AsString: String          read GetDataAsString        write SetDataAsString;
   property AsWideString: WideString  read GetDataAsWideString    write SetDataAsWideString;

   property AsABSDate: TABSDate       read GetDataAsABSDate       write SetDataAsABSDate;
   property AsABSTime: TABSTime       read GetDataAsABSTime       write SetDataAsABSTime;
   property AsABSDateTime: TABSDateTime read GetDataAsABSDateTime write SetDataAsABSDateTime;
   property AsTDate: TDateTime            read GetDataAsTDate         write SetDataAsTDate;
   property AsTTime: TDateTime            read GetDataAsTTime         write SetDataAsTTime;
   property AsTDateTime: TDateTime    read GetDataAsTDateTime     write SetDataAsTDateTime;

   property AsBoolean: TABSLogical    read GetDataAsBoolean       write SetDataAsBoolean;
   property AsLogical: TABSLogical    read GetDataAsBoolean       write SetDataAsBoolean;
   property AsCurrency: TABSCurrency  read GetDataAsCurrency      write SetDataAsCurrency;

   property AsVariant: Variant        read GetDataAsVariant       write SetDataAsVariant;
 end;


// Return Common DataType for 2 types, or ftUnknown
function GetCommonDataType(a,b: TABSBaseFieldType; ForCompare: Boolean=False): TABSBaseFieldType; overload;
// Return Common DataType for 2 types, or ftUnknown
function GetCommonDataType(a,b: TABSAdvancedFieldType; ForCompare: Boolean=False): TABSAdvancedFieldType; overload;

// Allocate new buffer and convert data to it
function CastToNewBuffer(
                          const Buffer;
                          const DataSize: Integer;
                          const DataType: TABSBaseFieldType;
                          const NewDataType: TABSBaseFieldType
                        ): PChar; overload;


// Allocate new buffer and convert data to it
function CastToNewBuffer(
                          const Buffer;
                          const DataSize: Integer;
                          const DataType: TABSBaseFieldType;
                          const NewDataType: TABSBaseFieldType;
                          out NewDataSize: Integer
                        ): PChar; overload;

// Compare 2 values
function CompareValueBuffers(
                              Buffer1, Buffer2: Pointer;
                              BaseFieldType1, BaseFieldType2: TABSBaseFieldType;
                              IsField1Null: Boolean = false;
                              IsField2Null: Boolean = false;
                              PartialCompareLength: Integer = -1;
                              IgnoreCase: Boolean = false;
                              LocaleID: LCID = LOCALE_USER_DEFAULT
                            ): TABSCompareResult;

// Compare 2 values in sense of order (-1,0,1)
function CompareValueBuffersForOrder(
                              Buffer1, Buffer2: Pointer;
                              BaseFieldType1, BaseFieldType2: TABSBaseFieldType;
                              IsField1Null: Boolean = false;
                              IsField2Null: Boolean = false;
                              PartialCompareLength: Integer = -1;
                              IgnoreCase: Boolean = false;
                              LocaleID: LCID = LOCALE_USER_DEFAULT
                            ): Integer;

implementation

uses
{$IFDEF D6H}
     Variants,
{$ENDIF}
     ABSStrUtils,
     ABSMain;



//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TABSVariant.LoadFromStream(Stream: TStream);
begin
  Clear;
  LoadDataFromStream(FDataType,Sizeof(FDataType),Stream,10183);
  LoadDataFromStream(FIsNull,Sizeof(FIsNull),Stream,10184);
  if (not FIsNull) then
   begin
    LoadDataFromStream(FDataSize,Sizeof(FDataSize),Stream,10185);
    FPData := MemoryManager.GetMem(FDataSize);
    LoadDataFromStream(FPData^,FDataSize,Stream,10186);
   end;
end; // LoadFromStream


//------------------------------------------------------------------------------
// save to stream
//------------------------------------------------------------------------------
procedure TABSVariant.SaveToStream(Stream: TStream);
begin
  SaveDataToStream(FDataType,Sizeof(FDataType),Stream,10179);
  SaveDataToStream(FIsNull,Sizeof(FIsNull),Stream,10180);
  if (not FIsNull) then
   begin
    SaveDataToStream(FDataSize,Sizeof(FDataSize),Stream,10181);
    SaveDataToStream(FPData^,FDataSize,Stream,10182);
   end;
end; // SaveToStream


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSVariant.Create(DataType: TABSBaseFieldType);
begin
  FPData := nil;
  FDataType := DataType;
  FDataSize := 0;
  FIsDataLinked := false;
  FIsNull := True;
end;//Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TABSVariant.Destroy;
begin
  Clear;
end;//Destroy


//------------------------------------------------------------------------------