sdmss.pas

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

  dbdataready:	function (dbproc: PDBPROCESS): BOOL; cdecl;
  dbdatecrack:	function (dbproc: PDBPROCESS; var dateinfo: DBDATEREC; datetime: TSDPtr{LPCDBDATETIME}): RETCODE; cdecl;
  dbdatlen:	function (dbproc: PDBPROCESS; column: INT): DBINT; cdecl;
  dbdead:	function (dbproc: PDBPROCESS): BOOL; cdecl;
  dbexit:	procedure ; cdecl;
  dbenlisttrans:function(dbproc: PDBPROCESS; pTransaction: LPVOID): RETCODE; cdecl;
  dbenlistxatrans:function(dbproc: PDBPROCESS; enlisttran: BOOL): RETCODE; cdecl;
//  dbfcmd:	function (PDBPROCESS, LPCSTR, ...): RETCODE; cdecl;
  dbfirstrow:	function (dbproc: PDBPROCESS): DBINT; cdecl;
  dbfreebuf:	procedure (dbproc: PDBPROCESS); cdecl;
  dbfreelogin:	procedure (login: PLOGINREC); cdecl;
  dbfreequal:	procedure (ptr: LPCSTR); cdecl;
  dbgetchar:	function (dbproc: PDBPROCESS; n: INT): LPSTR; cdecl;
  dbgetmaxprocs:function : SHORT; cdecl;
  dbgetoff:	function (dbproc: PDBPROCESS; offtype: DBUSMALLINT; startfrom: INT): INT; cdecl;
  dbgetpacket:	function (dbproc: PDBPROCESS): UINT; cdecl;
  dbgetrow:	function (dbproc: PDBPROCESS; row: DBINT): STATUS; cdecl;
  dbgettime:	function : INT; cdecl;
  dbgetuserdata:function (dbproc: PDBPROCESS): LPVOID; cdecl;
  dbhasretstat:	function (dbproc: PDBPROCESS): DBBOOL; cdecl;
  dbinit:	function : LPCSTR; cdecl;
  dbisavail:	function (dbproc: PDBPROCESS): BOOL; cdecl;
  dbiscount:	function (dbproc: PDBPROCESS): BOOL; cdecl;
  dbisopt:	function (dbproc: PDBPROCESS; option: INT; param: LPCSTR): BOOL; cdecl;
  dblastrow:	function (dbproc: PDBPROCESS): DBINT; cdecl;
  dblogin:	function : PLOGINREC; cdecl;
  dbmorecmds:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbmoretext:	function (dbproc: PDBPROCESS; size: DBINT; text: LPCBYTE): RETCODE; cdecl;
  dbname:	function (dbproc: PDBPROCESS): LPCSTR; cdecl;
  dbnextrow:	function (dbproc: PDBPROCESS): STATUS; cdecl;
  dbnullbind:	function (dbproc: PDBPROCESS; column: INT; indicator: LPCDBINT): RETCODE; cdecl;
  dbnumalts:	function (dbproc: PDBPROCESS; computeId: INT): INT; cdecl;
  dbnumcols:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbnumcompute:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbnumorders:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbnumrets:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbopen:	function (login: PLOGINREC; servername: LPCSTR): PDBPROCESS; cdecl;
  dbordercol:	function (dbproc: PDBPROCESS; order: INT): INT; cdecl;
  dbprocinfo:	function (dbproc: PDBPROCESS; var dbprcinfo: TDBPROCINFO): RETCODE; cdecl;
  dbprhead:	procedure (dbproc: PDBPROCESS); cdecl;
  dbprrow:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbprtype:	function (token: INT): LPCSTR; cdecl;
  dbqual:	function (dbproc: PDBPROCESS; tabnum: INT; tabname: LPCSTR): LPCSTR; cdecl;
//  dbreadpage:	function (dbproc: PDBPROCESS; LPCSTR, DBINT, LPBYTE): DBINT; cdecl;
  dbreadtext:	function (dbproc: PDBPROCESS; buf: LPVOID; bufsize: DBINT): DBINT; cdecl;
  dbresults:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbretdata:	function (dbproc: PDBPROCESS; retnum: INT): LPCBYTE; cdecl;
  dbretlen:	function (dbproc: PDBPROCESS; retnum: INT): DBINT; cdecl;
  dbretname:	function (dbproc: PDBPROCESS; retnum: INT): LPCSTR; cdecl;
  dbretstatus:	function (dbproc: PDBPROCESS): DBINT; cdecl;
  dbrettype:	function (dbproc: PDBPROCESS; retnum: INT): INT; cdecl;
  dbrows:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbrowtype:	function (dbproc: PDBPROCESS): STATUS; cdecl;
  dbrpcinit:	function (dbproc: PDBPROCESS; rpcname: LPCSTR; options: DBSMALLINT): RETCODE; cdecl;
  dbrpcparam:	function (dbproc: PDBPROCESS; paramname: LPCSTR; status: BYTE;
  			datatype: INT; maxlen, datalen: DBINT; value: LPCBYTE): RETCODE; cdecl;
  dbrpcsend:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbrpcexec:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
//  dbrpwclr:	procedure (PLOGINREC); cdecl;
//  dbrpwset:	function (PLOGINREC, LPCSTR, LPCSTR, INT): RETCODE; cdecl;
  dbserverenum:	function (searchmode: USHORT; servnamebuf: LPSTR; sizeservnamebuf: USHORT; numentries: LPUSHORT): INT; cdecl;
  dbsetavail:	procedure (dbproc: PDBPROCESS); cdecl;
  dbsetmaxprocs:function (maxprocs: SHORT): RETCODE; cdecl;
  dbsetlname:	function (login: PLOGINREC; value: LPCSTR; param: INT): RETCODE; cdecl;
  dbsetlogintime:function (seconds: INT): RETCODE; cdecl;
  dbsetlpacket:	function (login: PLOGINREC; packet_size: USHORT): RETCODE; cdecl;
  dbsetnull:	function (dbproc: PDBPROCESS; bindtype, bindlen: INT; bindval: LPCBYTE): RETCODE; cdecl;
  dbsetopt:	function (dbproc: PDBPROCESS; option: INT; param: LPCSTR): RETCODE; cdecl;
  dbsettime:	function (seconds: INT): RETCODE; cdecl;
  dbsetuserdata:procedure (dbproc: PDBPROCESS; ptr: LPVOID); cdecl;
  dbsqlexec:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbsqlok:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbsqlsend:	function (dbproc: PDBPROCESS): RETCODE; cdecl;
  dbstrcpy:	function (dbproc: PDBPROCESS; start, numbytes: INT; dest: LPSTR): RETCODE; cdecl;
  dbstrlen:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbtabbrowse:	function (dbproc: PDBPROCESS; tabnum: INT): BOOL; cdecl;
  dbtabcount:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbtabname:	function (dbproc: PDBPROCESS; tabnum: INT): LPCSTR; cdecl;
  dbtabsource:	function (dbproc: PDBPROCESS; colnum: INT; tabnum: LPINT): LPCSTR; cdecl;
  dbtsnewlen:	function (dbproc: PDBPROCESS): INT; cdecl;
  dbtsnewval:	function (dbproc: PDBPROCESS): LPCDBBINARY; cdecl;
  dbtsput:	function (dbproc: PDBPROCESS; newts: LPCDBBINARY; newtslen, tabnum: INT; tabname: LPCSTR): RETCODE; cdecl;
  dbtxptr:	function (dbproc: PDBPROCESS; column: INT): LPCDBBINARY; cdecl;
  dbtxtimestamp:function (dbproc: PDBPROCESS; column: INT): LPCDBBINARY; cdecl;
  dbtxtsnewval:	function (dbproc: PDBPROCESS): LPCDBBINARY; cdecl;
  dbtxtsput:	function (dbproc: PDBPROCESS; newtxts: LPCDBBINARY; colnum: INT): RETCODE; cdecl;
  dbuse:	function (dbproc: PDBPROCESS; dbname: LPCSTR): RETCODE; cdecl;
  dbvarylen:	function (dbproc: PDBPROCESS; column: INT): BOOL; cdecl;
  dbwillconvert:function (srctype, desttype: INT): BOOL; cdecl;
//  dbwritepage:	function (dbproc: PDBPROCESS; LPCSTR, DBINT, DBINT, LPBYTE): RETCODE; cdecl;
  dbwritetext:	function (dbproc: PDBPROCESS; objname: LPCSTR;
  			textptr: LPCDBBINARY; textptrlen: DBTINYINT; timestamp: LPCDBBINARY;
                        log: BOOL; size: DBINT; text: LPCBYTE): RETCODE; cdecl;
  dbupdatetext:	function (dbproc: PDBPROCESS; dest_object: LPCSTR; dest_textptr: LPCDBBINARY;
  			dest_timestamp: LPCDBBINARY; update_type: INT; insert_offset, delete_length: DBINT;
  			src_object: LPCSTR; src_size: DBINT; src_text: LPCDBBINARY): RETCODE; cdecl;

  dberrhandle:  function (handler: TDBERRHANDLE_PROC): TDBERRHANDLE_PROC; cdecl;
  dbmsghandle:  function (handler: TDBMSGHANDLE_PROC): TDBMSGHANDLE_PROC; cdecl;
  dbprocerrhandle:function (dbproc: PDBPROCESS; handler: TDBERRHANDLE_PROC): TDBERRHANDLE_PROC; cdecl;
  dbprocmsghandle:function (dbproc: PDBPROCESS; handler: TDBMSGHANDLE_PROC): TDBMSGHANDLE_PROC; cdecl;
{$ENDIF}

type
  ESDMssError = class(ESDEngineError)
  private
    FHProcess: PDBPROCESS;		// FDbProcess - pointer to DBPROCESS structure for communication with the SQLServer
    FSeverity: INT;
  public
    constructor Create(DbProc: PDBPROCESS; AErrorCode, ANativeError: TSDEResult;
      ASeverity: INT; const Msg: string; AErrorPos: LongInt);
    property HProcess: PDBPROCESS read FHProcess;
    property Severity: INT read FSeverity;
  end;

{ TIMssDatabase }
  TIMssConnInfo	= packed record
    ServerType:         Byte;
    DBProcPtr:		PDBPROCESS;	// pointer to DBPROCESS structure for communication with the SQLServer
    LoginRecPtr:	PLOGINREC;
    ServerNameStr: 	string;
  end;

  TIMssDatabase = class(TISqlDatabase)
  private
    FHandle: TSDPtr;

    FCurSqlCmd: TISqlCommand;		// a command, which uses a database handle currently (when FIsSingleConn is True)

    FByteAsGuid: Boolean;
    procedure Check(dbproc: PDBPROCESS);
    procedure AllocHandle;
    procedure FreeHandle;
    function GetDBProcPtr: PDBPROCESS;
    function GetLoginRecPtr: PLOGINREC;
    function GetServerName: string;
    procedure GetStmtResult(const Stmt: string; List: TStrings);
    procedure HandleExecCmd(AHandle: PDBPROCESS; const Stmt: string);
    procedure HandleSetAutoCommit(AHandle: PDBPROCESS);
    procedure HandleSetDefOptions(AHandle: PDBPROCESS);
    procedure HandleSetTransIsolation(AHandle: PDBPROCESS; Value: TISqlTransIsolation);
    procedure HandleReset(AHandle: PDBPROCESS);
    procedure SetDefaultOptions;
  protected
    function GetHandle: TSDPtr; override;
    procedure DoConnect(const sRemoteDatabase, sUserName, sPassword: string); override;
    procedure DoDisconnect(Force: Boolean); override;
    procedure DoCommit; override;
    procedure DoRollback; override;
    procedure DoStartTransaction; override;

    procedure SetAutoCommitOption(Value: Boolean); override;
    procedure SetHandle(AHandle: TSDPtr); override;
  public
    constructor Create(ADbParams: TStrings); override;
    destructor Destroy; override;
    function CreateSqlCommand: TISqlCommand; override;

    function GetAutoIncSQL: string; override;
    function GetClientVersion: LongInt; override;
    function GetServerVersion: LongInt; override;
    function GetVersionString: string; override;
    function GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TISqlCommand; override;

    procedure SetTransIsolation(Value: TISqlTransIsolation); override;
    function SPDescriptionsAvailable: Boolean; override;
    function TestConnected: Boolean; override;

    procedure ReleaseDBHandle(ASqlCmd: TISqlCommand; IsFetchAll, IsReset: Boolean);
    property CurSqlCmd: TISqlCommand read FCurSqlCmd;
    property DBProcPtr: PDBPROCESS read GetDBProcPtr;
    property LoginRecPtr: PLOGINREC read GetLoginRecPtr;
    property ServerName: string read GetServerName;
    property ByteAsGuid: Boolean read FByteAsGuid;
  end;

{ TIMssCommand }
  TIMssCommand = class(TISqlCommand)
  private
    FBindStmt: string;		// with bind parameter data, it's used to check whether the statement was executed
    FRowsAffected: DBINT;	// number of rows affected by the last Transact-SQL statement (DML)
    FHandle: PDBPROCESS;
    FIsSingleConn: Boolean;	// True, if it's required to use a database handle always
    FConnected: Boolean;	// True, when Connect method was called
    FNextResults: Boolean;	// if one of multiple result sets processing
    FEndResults: Boolean;	// if all results have been processed

    procedure Connect;
    function CanReturnRows: Boolean;
    function CnvtDateTimeToSQLVarChar(ADataType: TFieldType; Value: TDateTime): string;
    function CnvtDateTimeToSQLDateTime(Value: TDateTime): DBDATETIME;
    function CnvtDBDateTime2DateTimeRec(ADataType: TFieldType; Buffer: TSDValueBuffer; BufSize: Integer): TDateTimeRec;
    function CnvtFloatToSQLVarChar(Value: Double): string;
    function CreateDBProcess: PDBPROCESS;
    procedure HandleCancel(AHandle: PDBPROCESS);
    procedure HandleCurReset(AHandle: PDBPROCESS);
    procedure HandleReset(AHandle: PDBPROCESS);
    procedure HandleSpInit(AHandle: PDBPROCESS; ARpcName: string);
    procedure HandleSpExec(AHandle: PDBPROCESS);
    function HandleSpResults(AHandle: PDBPROCESS): Boolean;
    function GetExecuted: Boolean;
    function GetSqlDatabase: TIMssDatabase;
    function GetDBHandleAcquired: Boolean;
    procedure InternalExecute;
    procedure InternalQBindParams;
    procedure InternalQExecute;
    procedure InternalSpBindParams;
    procedure InternalSpExecute;
    procedure InternalSpGetParams;
    procedure FetchDataSize;
  protected
    procedure Check;
    procedure AcquireDBHandle;
    procedure ReleaseDBHandle;
    procedure ReleaseDBHandleWOReset;

    procedure AllocParamsBuffer; override;
    procedure BindParamsBuffer; override;
    procedure FreeParamsBuffer; override;
    function GetParamsBufferSize: Integer; override;
    procedure DoExecute; override;
    procedure DoExecDirect(Value: string); override;
    procedure DoPrepare(Value: string); override;
    procedure GetFieldDescs(Descs: TSDFieldDescList); override;
    function GetHandle: PSDCursor; override;
    procedure InitParamList; override;
    procedure SetFieldsBuffer; override;

    function FieldDataType(ExtDataType: Integer): TFieldType; override;
    function NativeDataSize(FieldType: TFieldType): Word; override;
    function NativeDataType(FieldType: TFieldType): Integer; override;
    function RequiredCnvtFieldType(FieldType: TFieldType): Boolean; override;
  public
    constructor Create(ASqlDatabase: TISqlDatabase); override;
    destructor Destroy; override;
	// command interface
    procedure CloseResultSet; override;
    procedure Disconnect(Force: Boolean); override;
    procedure Execute; override;
    function GetRowsAffected: Integer; override;
    function NextResultSet: Boolean; override;
    function ResultSetExists: Boolean; override;
	// cursor interface
    function FetchNextRow: Boolean; override;
    function GetCnvtFieldData(AFieldDesc: TSDFieldDesc; Buffer: TSDPtr; BufSize: Integer): Boolean; override;
    procedure GetOutputParams; override;
    function ReadBlob(AFieldDesc: TSDFieldDesc; var BlobData: TSDBlobData): Longint; override;

    procedure ResetExecuted;
    property Executed: Boolean read GetExecuted;
    property DBHandleAcquired: Boolean read GetDBHandleAcquired;
    property SqlDatabase: TIMssDatabase read GetSqlDatabase;
  end;

const
  DefSqlApiDLL	= 'NTWDBLIB.DLL';

var
  SqlApiDLL: string;

{*******************************************************************************
		Load/Unload Sql-library
*******************************************************************************}
procedure LoadSqlLib;
procedure FreeSqlLib;

function InitSqlDatabase(ADbParams: TStrings): TISqlDatabase;

{$IFDEF SD_CLR}
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbbind')]
function dbbind(dbproc: PDBPROCESS; column, vartype: INT; varlen: DBINT; varaddr: LPBYTE): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcancel')]
function dbcancel(dbproc: PDBPROCESS): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcanquery')]
function dbcanquery(dbproc: PDBPROCESS): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbclose')]
function dbclose(dbproc: PDBPROCESS): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbclrbuf')]
procedure dbclrbuf(dbproc: PDBPROCESS; n: DBINT); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbclropt')]
function dbclropt(dbproc: PDBPROCESS; option: INT; param: LPCSTR): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcmd')]
function dbcmd(dbproc: PDBPROCESS; cmdstring: LPCSTR): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcmdrow')]
function dbcmdrow(dbproc: PDBPROCESS): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcolinfo')]
function dbcolinfo(dbHandle: PDBHANDLE; colinfo, column, computeId: INT; var DbCol: TDBCOL): RETCODE; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcollen')]
function dbcollen(dbproc: PDBPROCESS; column: INT): DBINT; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcolname')]
function dbcolname(dbproc: PDBPROCESS; column: INT): LPCSTR; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbcoltype')]
function dbcoltype(dbproc: PDBPROCESS; column: INT): INT; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'dbconvert')]