myldbvariant.pas

一个本地database引擎,支持中文T_Sql查询,兼容DELPHI标准数据库控件

unit MYLDBVariant;

{$I MYLDBVer.inc}

interface

uses SysUtils, Classes,

      Windows, Math,

// MYLDBoluteDatabase units

{$IFNDEF D6H}
     MYLDBD4Routines,
{$ENDIF}
     {$IFDEF DEBUG_LOG}
     MYLDBDebug,
     {$ENDIF}
     MYLDBCompression,
     MYLDBTypes,
     MYLDBTypesRoutines,
     MYLDBConst,
     MYLDBConverts,
     MYLDBMemory,
     MYLDBExcept;

type

 TMYLDBVariant = class(TObject)
  private
   FDataType:     TMYLDBBaseFieldType;    // type of data
   FDataSize:     Integer;              // size of data value
   FPData:        PChar;                // Binary data representation
   FIsDataLinked: ByteBool;             // freemem required?
   FIsNull:       ByteBool;             // MYLDBtract Boolean Flag
  public
   procedure LoadFromStream(Stream: TStream);
   procedure SaveToStream(Stream: TStream);
   // Constructor
   constructor Create(DataType: TMYLDBBaseFieldType = bftUnknown);
   // Destructor
   destructor Destroy; override;
   // SetNull
   procedure SetNull(DataType: TMYLDBBaseFieldType = bftUnknown);
   // Free Buffer
   procedure Clear(DataType: TMYLDBBaseFieldType = bftUnknown);
   // Assign data from source (or make link to Source.Data)
   procedure Assign(Source: TMYLDBVariant; CopyDataFlag: boolean = true);
   // Set Data (or make link to Data)
   procedure SetData(Buffer: Pointer; Size: Integer;
                     DataType: TMYLDBBaseFieldType;
                     CopyDataFlag: boolean = true);
   // Copy Data to Address
   function CopyDataToAddress(Buffer: Pointer; MaxSize: Integer = -1): boolean;
   // Cast to new data type
   procedure Cast(NewDataType: TMYLDBBaseFieldType);
   // 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: TMYLDBVariant);
   // data := data - value
   procedure Sub(Value: TMYLDBVariant);
   // data := data * value
   procedure Mul(Value: TMYLDBVariant);
   // data := data / value
   procedure Division(Value: TMYLDBVariant);

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

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

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

   // 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 MYLDBDate
   procedure SetDataAsMYLDBDate(Value: TMYLDBDate);
   // Get Data for MYLDBDate
   function  GetDataAsMYLDBDate: TMYLDBDate;
   // Set Data for TDate
   procedure SetDataAsTDate(Value: TDateTime);
   // Get Data for TDate
   function  GetDataAsTDate: TDateTime;


   // Set Data for MYLDBTime
   procedure SetDataAsMYLDBTime(Value: TMYLDBTime);
   // Get Data for MYLDBTime
   function  GetDataAsMYLDBTime: TMYLDBTime;
   // Set Data for TTime
   procedure SetDataAsTTime(Value: TDateTime);
   // Get Data for TTime
   function  GetDataAsTTime: TDateTime;

   // Set Data for MYLDBDateTime
   procedure SetDataAsMYLDBDateTime(Value: TMYLDBDateTime);
   // Get Data for MYLDBDateTime
   function  GetDataAsMYLDBDateTime: TMYLDBDateTime;
   // Set Data for TDateTime
   procedure SetDataAsTDateTime(Value: TDateTime);
   // Get Data for TDateTime
   function  GetDataAsTDateTime: TDateTime;

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


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

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

  public
   property DataType: TMYLDBBaseFieldType 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 AsMYLDBDate: TMYLDBDate       read GetDataAsMYLDBDate       write SetDataAsMYLDBDate;
   property AsMYLDBTime: TMYLDBTime       read GetDataAsMYLDBTime       write SetDataAsMYLDBTime;
   property AsMYLDBDateTime: TMYLDBDateTime read GetDataAsMYLDBDateTime write SetDataAsMYLDBDateTime;
   property AsTDate: TDateTime            read GetDataAsTDate         write SetDataAsTDate;
   property AsTTime: TDateTime            read GetDataAsTTime         write SetDataAsTTime;
   property AsTDateTime: TDateTime    read GetDataAsTDateTime     write SetDataAsTDateTime;

   property AsBoolean: TMYLDBLogical    read GetDataAsBoolean       write SetDataAsBoolean;
   property AsLogical: TMYLDBLogical    read GetDataAsBoolean       write SetDataAsBoolean;
   property AsCurrency: TMYLDBCurrency  read GetDataAsCurrency      write SetDataAsCurrency;

   property AsVariant: Variant        read GetDataAsVariant       write SetDataAsVariant;
 end;


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

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


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

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

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

implementation

uses
{$IFDEF D6H}
     Variants,
{$ENDIF}
     MYLDBStrUtils,
     MYLDBMain;



//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TMYLDBVariant.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 TMYLDBVariant.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 TMYLDBVariant.Create(DataType: TMYLDBBaseFieldType);
begin
  FPData := nil;
  FDataType := DataType;
  FDataSize := 0;
  FIsDataLinked := false;
  FIsNull := True;
end;//Create


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