sdcommon.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

    function GetFieldBufOffs(Index: Integer): Integer; 	// Index is equal (FieldNo-1)
    function GetPrepared: Boolean;
    function GetSqlDatabase: TISqlDatabase;
    procedure SetParamsRef(Value: TSDHelperParams);
  protected
    procedure AddParam(AParamName: string; ADataType: TFieldType; AParamType: TSDHelperParamType);
    function GetFieldBuffer(AFieldNo: Integer; SelBuf: TSDPtr): TSDPtr;
  protected	// virtual methods
    procedure DoReleaseHandle(SaveRes: Boolean); virtual;

    procedure AllocParamsBuffer; virtual;
    procedure AllocFieldsBuffer; virtual;
    procedure BindParamsBuffer; virtual;
    procedure FreeParamsBuffer; virtual;
    procedure FreeFieldsBuffer; virtual;
    procedure SetFieldsBuffer; virtual;

    procedure DoPrepare(ACommandValue: string); virtual; abstract;
    procedure DoExecDirect(ACommandValue: string); virtual; abstract;
    procedure DoExecute; virtual; abstract;

    function CnvtDateTime2DBDateTime(ADataType: TFieldType; Value: TDateTime; Buffer: TSDValueBuffer; BufSize: Integer): Integer; virtual;
    procedure InitParamList; virtual;
    procedure ClearFieldDescs;

    procedure FetchBlobFields; virtual;
    function FieldDataType(ExtDataType: Integer): TFieldType; virtual;
    function FieldDescByName(const AFieldName: string): TSDFieldDesc;
    procedure GetFieldDescs(Descs: TSDFieldDescList); virtual;
    function GetFieldsBuffer: TSDRecordBuffer; virtual;
    function GetFieldsBufferSize: Integer; virtual;
    function GetHandle: PSDCursor; virtual;
    function GetParamsBufferSize: Integer; virtual;
    function NativeDataSize(FieldType: TFieldType): Word; virtual;
    function NativeDataType(FieldType: TFieldType): Integer; virtual;
    function NativeParamSize(Param: TSDHelperParam): Integer;
    procedure ParseFieldNames(const theSelect: string; FldInfo: TStrings);
    function RequiredCnvtFieldType(FieldType: TFieldType): Boolean; virtual;
    procedure SetCommandText(Value: string);
    procedure SetNativeCommand(Value: string);

    property BufList: TSDBufferList read FBufList;
    property NativeCommand: string read FNativeCommand;
    property ParamsBuffer: TSDRecordBuffer read FParamsBuffer;
    property FieldsBuffer: TSDRecordBuffer read GetFieldsBuffer;
    property FieldBufOffs[Index: Integer]: Integer read GetFieldBufOffs;
  public
    constructor Create(ASqlDatabase: TISqlDatabase); virtual;
    destructor Destroy; override;
    procedure SaveResults;
	// command interface
    procedure CloseResultSet; virtual;
    procedure Disconnect(Force: Boolean); virtual;
    procedure InitNewCommand; virtual;
    procedure ExecDirect(ACommandValue: string); virtual;
    procedure Execute; virtual;
    function GetAutoIncValue: Integer; virtual;     
    function GetRowsAffected: Integer; virtual;
    function NextResultSet: Boolean; virtual;
    procedure Prepare(ACommandValue: string); virtual;
    function ResultSetExists: Boolean; virtual;
	// cursor interface
    function FetchNextRow: Boolean; virtual;
    procedure InitFieldDescs; virtual;
    function GetCnvtFieldData(AFieldDesc: TSDFieldDesc; Buffer: TSDPtr; BufSize: Integer): Boolean; virtual;
    function GetBlobValue(AFieldDesc: TSDFieldDesc): TSDBlobData;
    procedure GetOutputParams; virtual;

    procedure PutBlobValue(AFieldDesc: TSDFieldDesc; sBlobValue: TSDBlobData);
    function ReadBlob(AFieldDesc: TSDFieldDesc; var BlobData: TSDBlobData): Longint; virtual;
    function WriteBlob(FieldNo: Integer; const Buffer: TSDValueBuffer; Count: Longint): Longint; virtual;
    function WriteBlobByName(Name: string; const Buffer: TSDValueBuffer; Count: Longint): Longint; virtual;

	// cursor interface
{
    function GetFieldDouble(AFieldNo: Word; Value: Pointer): Boolean;
    function GetFieldLong(AFieldNo: Word; Value: Pointer): Boolean;
    function GetFieldShort(AFieldNo: Word; Value: Pointer): Boolean;
    function GetFieldString(AFieldNo: Word; Value: Pointer): Boolean; }
{$IFDEF SD_VCL4}
    function GetFieldAsInt64(AFieldNo: Word; var Value: TInt64): Boolean;
{$ENDIF}
    function GetFieldAsInt16(AFieldNo: Word; var Value: SmallInt): Boolean;
    function GetFieldAsInt32(AFieldNo: Word; var Value: LongInt): Boolean;
    function GetFieldAsFloat(AFieldNo: Word; var Value: Double): Boolean;
    function GetFieldAsString(AFieldNo: Word; var Value: string): Boolean;

    property BlobCacheOffs: Integer read FBlobCacheOffs;
    property BlobFieldCount: Integer read FBlobFieldCount;
    property CommandType: TSDCommandType read FCommandType write FCommandType;
    property CommandText: string read FCommandText;
    property FieldDescs: TSDFieldDescList read FFieldDescs;
    property Handle: PSDCursor read GetHandle;
//    property NativeHandle: PSDCursor read GetNativeHandle; implement later
    property MaxCharParamSize: Integer read FMaxCharParamSize;
    property Params: TSDHelperParams read FParamsRef write SetParamsRef;
    property Prepared: Boolean read GetPrepared;
    property SqlDatabase: TISqlDatabase read GetSqlDatabase;
    property OnReleaseHandle: TSDReleaseHandleEvent read FReleaseHandle write FReleaseHandle;
  end;

{$IFNDEF SD_VCL4}		{ for Delphi 3 & C++ Builder 3 }

{ TSDParam }

  TSDParam = class(TPersistent)
  private
    FParamList: TSDParams;
    FData: Variant;
    FName: string;
    FDataType: TFieldType;
    FNull: Boolean;
    FBound: Boolean;
    FParamType: TSDParamType;
    procedure InitValue;
  protected
    procedure AssignParam(Param: TSDParam);
    procedure AssignTo(Dest: TPersistent); override;
    function GetAsBCD: Currency;
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: Double;
    function GetAsInteger: Longint;
    function GetAsMemo: string;
    function GetAsString: string;
    function GetAsVariant: Variant;
    function GetParamName: string;
    function IsEqual(Value: TSDParam): Boolean;
    procedure SetAsBCD(Value: Currency);
    procedure SetAsBlob(Value: TBlobData);
    procedure SetAsBoolean(Value: Boolean);
    procedure SetAsCurrency(Value: Double);
    procedure SetAsDate(Value: TDateTime);
    procedure SetAsDateTime(Value: TDateTime);
    procedure SetAsFloat(Value: Double);
    procedure SetAsInteger(Value: Longint);
    procedure SetAsMemo(const Value: string);
    procedure SetAsSmallInt(Value: LongInt);
    procedure SetAsString(const Value: string);
    procedure SetAsTime(Value: TDateTime);
    procedure SetAsVariant(Value: Variant);
    procedure SetAsWord(Value: LongInt);
    procedure SetDataType(Value: TFieldType);
    procedure SetParamName(const Value: string);
    procedure SetText(const Value: string);
  public
    constructor Create(AParamList: TSDParams; AParamType: TSDParamType);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure AssignField(Field: TField);
    procedure AssignFieldValue(Field: TField; const Value: Variant);
    procedure Clear;
    procedure GetData(Buffer: Pointer);
    function GetDataSize: Integer;
    procedure SetData(Buffer: Pointer);
    procedure SetBlobData(Buffer: Pointer; Size: Integer);
    procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
    procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
    property Name: string read GetParamName write SetParamName;
    property DataType: TFieldType read FDataType write SetDataType;
    property AsBCD: Currency read GetAsBCD write SetAsBCD;
    property AsBlob: TBlobData read GetAsString write SetAsBlob;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsCurrency: Double read GetAsFloat write SetAsCurrency;
    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsInteger: LongInt read GetAsInteger write SetAsInteger;
    property AsMemo: string read GetAsMemo write SetAsMemo;
    property AsString: string read GetAsString write SetAsString;
    property AsSmallInt: LongInt read GetAsInteger write SetAsSmallInt;
    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
    property AsWord: LongInt read GetAsInteger write SetAsWord;
    property IsNull: Boolean read FNull;
    property ParamType: TSDParamType read FParamType write FParamType;
    property Bound: Boolean read FBound write FBound;
    property Text: string read GetAsString write SetText;
    property Value: Variant read GetAsVariant write SetAsVariant;
  end;

{ TSDParams }

  TSDParams = class(TPersistent)
  private
    FItems: TList;
    function GetParam(Index: Word): TSDParam;
    function GetParamValue(const ParamName: string): Variant;
    function GetVersion: Word;
    procedure ReadBinaryData(Stream: TStream);
    procedure SetParamValue(const ParamName: string; const Value: Variant);
    procedure WriteBinaryData(Stream: TStream);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure AssignValues(Value: TSDParams);
    procedure AddParam(Value: TSDParam);
    procedure RemoveParam(Value: TSDParam);
    function CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TSDParamType): TSDParam;
    function Count: Integer;
    procedure Clear;
    procedure GetParamList(List: TList; const ParamNames: string);
    function IsEqual(Value: TSDParams): Boolean;
    function ParamByName(const Value: string): TSDParam;
    property Items[Index: Word]: TSDParam read GetParam; default;
    property ParamValues[const ParamName: string]: Variant read GetParamValue write SetParamValue;
  end;
{$ENDIF}	{ for Delphi 3 & C++ Builder }

{$IFDEF SD_VCL5}	{ for Delphi 5 & above }

{ TSDExprParser }

  TSDExprParser = class(TExprParser)
  private
    FDataSet: TDataSet;
    FFilteredFields: TStringList;
    function GetLiteralStart(StartPtr: Integer): Word;
    function GetNodeOperator(NodePtr: Integer): TCANOperator;
    function GetNodeValue(StartPos, NodePos: Integer): Variant;
    function GetUnaryNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetBinaryNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetCompareNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetConstNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetFieldNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetFuncNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetListNodeValue(StartPtr, NodePtr: Integer): Variant;
    function GetOpInValue(V1, V2: Variant): Variant;
    function GetOpLikeValue(V1, V2: Variant): Variant;
    function FieldByName(const FieldName: string): TField;
  public
    constructor Create(DataSet: TDataSet; const Text: string;
      Options: TFilterOptions; ParserOptions: TParserOptions;
      const FieldName: string; DepFields: TBits; FieldMap: TFieldMap);
    destructor Destroy; override;
    function CalcBooleanValue: Boolean;
    function CalcVariantValue: Variant;
    procedure ClearFields;
  end;
{$ENDIF}	{ for Delphi 5 & above }

{$IFNDEF SD_VCL5}	{ for TBCDField support }
type
  PBcd = ^TBcd;
  TBcd  = packed record
    Precision: Byte;                        { 1..64 }
    SignSpecialPlaces: Byte;                { Sign:1, Special:1, Places:6 }
    Fraction: packed array [0..31] of Byte; { BCD Nibbles, 00..99 per Byte, high Nibble 1st }
  end;

function CurrToBCD(Curr: Currency; var BCD: TBcd; Precision, Decimals: Integer): Boolean;
function BCDToCurr(const BCD: TBcd; var Curr: Currency): Boolean;
{$ENDIF}


function GetAppName: string;
function GetHostName: string;
function GetFileVersion(const FileName: string): LongInt;
function GetModuleFileNameStr(hModule: HINST): string;
function GetMajorVer(Ver: LongInt): Word;
function GetMinorVer(Ver: LongInt): Word;
function MakeVerValue( MajorVer, MinorVer: Word ): Integer;
procedure ReadFileVersInfo(const FileName: string; var ProductName, VersStr: string);
function VersionStringToDWORD(const VerStr: AnsiString): LongInt;
function GetSqlLibParamName(ServerTypeCode: Integer): string;
function GetSQLDirectVersion: string;

function ExtractLibName(const LibNames: string; Sep: Char; var Pos: Integer): string;
function ExtractStoredProcName(const sFullProcName: string): string;
{ functions to parsing TSDDatabase.RemoteDatabase property. They're used in SDMss.pas, SDMySQL.pas }
function ExtractServerName(const sRemoteDatabase: string): string;
function ExtractDatabaseName(const sRemoteDatabase: string): string;
function ExtractOwnerObjNames(const AFullObjName: string; var AOwnerName, AObjName: string): Boolean;

function IsBlobType(FieldType: TFieldType): Boolean;
function IsDateTimeType(FieldType: TFieldType): Boolean;
function IsNumericType(FieldType: TFieldType): Boolean;
function IsSupportedBlobTypes(FieldType: TFieldType): Boolean;
function IsRequiredSizeTypes(FieldType: TFieldType): Boolean;

{ it is used in SDMss and SDSyb units for convert binary type to hex string }
function CnvtVarBytesToHexString(Value: Variant): string;
{ ------- The following functions are used in SDMySQL and SDPgSQL units ------ }
function SqlDateToDateTime(Value: string): TDateTime;
function SqlTimeToDateTime(Value: string): TDateTime;
function SqlStrToFloatDef(Value: AnsiString; Default: Double): Double;
function SqlStrToBoolean(Value: AnsiString): Boolean;
{ ------- The previous functions are used in SDMySQL and SDPgSQL units ------- }

procedure GuidToCharBuffer(SrcBuf: TSDValueBuffer; SrcBufLen: Integer; DstBuf: TSDValueBuffer; DstBufLen: Integer);

{ For compatibility with all Delphi version: exclude using of Math unit }
function MaxIntValue(A, B: Integer): Integer;
function MinIntValue(A, B: Integer): Integer;

{ String-processing functions }

function IsNameDelimiter(C: Char): Boolean;
function IsLiteral(C: Char): Boolean;

function IsOldPrefixExists(const AParamName, OldPrefix: string): Boolean;
{ Locates the position of a sub-string within a string like AnsiPos, but AnsiTextPos is case-insensitive }
function LocateText(const Substr, S: AnsiString): Integer;
function StripLiterals(const Str: string): string;
function RepeatChar(Ch: Char; S: string): string;
{ Replaces OldStr (as word, separated delimiters) and returns True when the replacing is successful }
function ReplaceString( Once: Boolean; OldStr, NewStr: string; var ResultStr: string ): Boolean;
function StrFindFromPos(const Substr, S: string; StartPos: Integer): Integer;

{$IFDEF SD_CLR}
function StrNew( S: TSDCharPtr ): TSDCharPtr;
{$ENDIF}
procedure StrRTrim( S: TSDCharPtr );
{$IFNDEF SD_CLR temporary, D8}
        // it is not used while
procedure MoveString(SrcStr: string; SrcPos: Integer; var DestStr: string; DestPos, Count : Integer);
{$ENDIF}

function CompareVar(V1, V2: Variant; CaseInsensitive: Boolean): Integer;
function VarIsEqual(AVar1, AVar2: Variant; CaseInsensitive, PartialKey, AtStartOnly: Boolean): Boolean;
function VarIsStrType(const AValue: Variant): Boolean;

{ Can query SQL returns an updatable(live) result set ? Return a table name or an empty string. }
function IsLiveQuery(const SQL: string): string;
{ Is SELECT statetement ? }
function IsSelectQuery(const SQL: string): Boolean;
procedure CreateParamsFromSQL(List: TSDHelperParams; const SQL: string; ParamPrefix: Char);
{$IFDEF SD_VCL4}
function GenerateSQL(UpdateStatus: TUpdateStatus; UpdateMode: TUpdateMode;
	const TableName: string; FieldInfo: TStrings; Fields: TFields; QuoteIdent: Boolean): string;
{$ENDIF}
function ContainsLikeWildcards(const s: string): Boolean;
function ExtractColumnName(const AFieldInfo: string): string;
procedure ParseTableFieldsFromSQL(const theSelect: string; const FieldList: TStrings; FldInfo, TblInfo: TStrings);
function QuoteIdentifier(AName: string; UseQuote: Boolean): string;
function CreateProcedureCallCommand( AProcName: string; AParams: TSDHelperParams; IsMSSQL: Boolean ): string;
function ReplaceParamMarkers( OldStmt: string; AParams: TSDHelperParams): string;

function GetFieldInfoDataSizeOff: Integer;
function GetFieldInfoFetchStatusOff: Integer;
function GetFieldInfoStruct(Buffer: TSDPtr; Offset: Integer): TSDFieldInfo;
function GetFieldBlobData(RecBuf: TSDRecordBuffer; ABlobCacheOffs, AFieldOffset: Integer): TSDBlobData;
function GetFieldBlobDataSize(RecBuf: TSDRecordBuffer; ABlobCacheOffs, AFieldOffset: Integer): Integer;