mod-fbs-public.pb
Code: Select all
Declare.i Allocate(*sv, dbh)
Declare.i Begin(*sv, dbh)
Declare BindDouble(*bfr, idx, itm.d)
Declare BindFloat(*bfr, idx, itm.f)
Declare.i BindInteger(*bfr, idx, itm)
Declare.i BindNull(*bfr, idx)
Declare.i BindString(*bfr, idx, itm.s)
Declare.i Close(*sv, dbh)
Declare.i Commit(*sv, txh)
Declare.i Connect(*sv, DatabaseAlias$, Username$, Password$, Role$="")
Declare.i FetchNext(*sv, stmt, *sqlda_out)
Declare.i Free(*sv, stmt, *sqlda_out=#Null, *sqlda_in=#Null)
Declare FreeField(*fld.fbField)
Declare.s FieldDate(*fld.fbField)
Declare.d FieldDouble(*fld.fbField)
Declare.f FieldFloat(*fld.fbField)
Declare.i FieldInteger(*fld.fbField)
Declare.q FieldQuad(*fld.fbField)
Declare.s FieldString(*fld.fbField)
Declare.s FieldTime(*fld.fbField)
Declare.s FieldTimeStamp(*fld.fbField)
Declare.s GetError(*sv)
Declare.i GetField(*bfr, idx)
Declare.i GetFieldCount(*bfr)
Declare.i Prepare(*sv, txh, stmt, sql.s)
Declare.i Rollback(*sv, txh)
Declare.i SQLExecute(*sv, dbh, txh, qry.s)
Declare.i SQLExecuteP(*sv, txh, stmt, *sqlda_in)
Declare.i SQLSelect(*sv, txh, stmt, sql.s)
Declare.i SQLSelectP(*sv, txh, stmt, *sqlda_in)
Code: Select all
Declare.i _buffer_size(nFields)
Declare _create_buffers(*sqlda_out, nFields.w)
Declare.i _describe(*sv, stmt, *sqlda_out, nFields.w)
Declare _describe_bind(*sv, stmt, *sqlda_in, nFields.w)
Declare.i _execute(*sv, txh, stmt, *sqlda_in=#Null)
Declare.s _extract_date(nDate.i)
Declare.s _extract_time(nTime.i)
Declare.i _field_string(*fld.fbField)
Declare _free_buffers(*bfr)
Declare.i _position_pointer(nFields)
Declare _new_sqlda(*buffer, nFields.w, isparams=#False)
Declare.w _prepare(*sv, txh, stmt, sql.s)
Code: Select all
DeclareModule fb
;data type constants
#FB_SQL_ARRAY = 540
#FB_SQL_BLOB = 520
#FB_SQL_DATE = 510
#FB_SQL_DOUBLE = 480
#FB_SQL_D_FLOAT = 530
#FB_SQL_FLOAT = 482
#FB_SQL_INT64 = 580
#FB_SQL_LONG = 496
#FB_SQL_QUAD = 550
#FB_SQL_SHORT = 500
#FB_SQL_TEXT = 452
#FB_SQL_TIMESTAMP = 510
#FB_SQL_TYPE_DATE = 570
#FB_SQL_TYPE_TIME = 560
#FB_SQL_VARYING = 448
#FB_SQL_BOOLEAN = 32764
#FB_SQL_NULL = 32766
;some other required constants
;database parameter buffer constants
#isc_dpb_version1 = 1
#isc_dpb_user_name = 28
#isc_dpb_password = 29
#isc_dpb_sql_role_name = 60
#isc_dpb_sql_dialect = 63
#isc_dpb_lc_ctype = 48
;transaction parameter buffer constants
#isc_tpb_concurrency = 2
#isc_tpb_version3 = 3
#isc_tpb_wait = 6
#isc_tpb_write = 9
#DSQL_CLOSE = 1
#DSQL_DROP = 2
#SQLDA_VERSION1 = 1
#FB_SQL_DIALECT_V5 = 1
#FB_SQL_DIALECT_V6 = 3
Enumeration
#FB_Client
EndEnumeration
Structure ISC_STATUS ;used for retrieveing error messages
vector.i[20]
EndStructure
Structure XSQLDA Align #PB_Structure_AlignC
version.w
sqldaid.b[8]
sqldabc.l
sqln.w
sqld.w
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
wtf.l ; for some reason on 64 bit the first XSQLVAR is offset by 4 bytes?!
CompilerEndIf
EndStructure
Structure XSQLVAR Align #PB_Structure_AlignC
sqltype.w
sqlscale.w
sqlsubtype.w
sqllen.w
sqldata.i
sqlind.i
sqlname_length.w
sqlname.b[32]
relname_length.w
relname.b[32]
ownname_length.w
ownname.b[32]
aliasname_length.w
aliasname.b[32]
EndStructure
Structure fbField
name.s
type.w
subtype.w
size.w
scale.w
isnull.w
length.w
buffer.i
pbtype.i
stringval.s
EndStructure
Global fbLibrary$
XIncludeFile "mod-fbs-public.pb"
EndDeclareModule
Module fb
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
fbLibrary$ = "fbclient32.dll"
CompilerElse
fbLibrary$ = "fbclient64.dll"
CompilerEndIf
; other platforms are as yet untested...
CompilerCase #PB_OS_Linux
fbLibrary$ = "libfbclient.so"
CompilerCase #PB_OS_MacOS
fbLibrary$ = "Firebird.framework"
CompilerEndSelect
lResult.i = OpenLibrary(#FB_Client, fbLibrary$)
If Not lResult
MessageRequester("Error", "Library not found", 0)
End
EndIf
XIncludeFile "mod-fbs-private.pb"
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Prototype.i isc_attach_database(*StatusVector, dbNameLength.w, *dbName, *dbHandle, DPBSize.w, *DPB)
Prototype.i isc_detach_database(*StatusVector, *dbHandle)
Prototype.i isc_rollback_transaction(*StatusVector, *TransactionHandle)
Prototype.i isc_commit_transaction(*StatusVector, *TransactionHandle)
Prototype.i isc_dsql_alloc_statement2(*StatusVector, *dbHandle, *QueryHandle)
Prototype.i isc_dsql_prepare(*StatusVector, *TransactionHandle, *QueryHandle, SQLlength.w, *SQLstring, Dialect.w, *XSQLDA)
Prototype.i isc_dsql_describe(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
Prototype.i isc_dsql_describe_bind(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
Prototype.i fb_interpret(*Buffer, SizeOfBuffer.i, *PtrToStatusVector)
Prototype.i isc_sqlcode(*StatusVector)
Prototype.i isc_sql_interpret(SQLCode.w, *Buffer, SizeOfBuffer.w)
Prototype.i isc_dsql_fetch(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
Prototype.i isc_dsql_free_statement(*StatusVector, *QueryHandle, free_option.w)
Prototype.i isc_dsql_execute_immediate(*StatusVector, *dbHandle, *TransactionHandle, SQL_length.w, *SQLstring, Dialect.w, *XSQLDA)
Prototype.i isc_dsql_execute(*StatusVector, *TransactionHandle, *QueryHandle, da_version.w, *XSQLDA_IN)
Prototype.i isc_dsql_execute2(*StatusVector, *TransactionHandle, *QueryHandle, da_version.w, *XSQLDA_IN, *XSQLDA_OUT)
CompilerElse
PrototypeC.i isc_attach_database(*StatusVector, dbNameLength.w, *dbName, *dbHandle, DPBSize.w, *DPB)
PrototypeC.i isc_detach_database(*StatusVector, *dbHandle)
PrototypeC.i isc_rollback_transaction(*StatusVector, *TransactionHandle)
PrototypeC.i isc_commit_transaction(*StatusVector, *TransactionHandle)
PrototypeC.i isc_dsql_alloc_statement2(*StatusVector, *dbHandle, *QueryHandle)
PrototypeC.i isc_dsql_prepare(*StatusVector, *TransactionHandle, *QueryHandle, SQLlength.w, *SQLstring, Dialect.w, *XSQLDA)
PrototypeC.i isc_dsql_describe(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
PrototypeC.i isc_dsql_describe_bind(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
PrototypeC.i fb_interpret(*Buffer, SizeOfBuffer.i, *PtrToStatusVector)
PrototypeC.i isc_sqlcode(*StatusVector)
PrototypeC.i isc_sql_interpret(SQLCode.w, *Buffer, SizeOfBuffer.w)
PrototypeC.i isc_dsql_fetch(*StatusVector, *QueryHandle, da_version.w, *XSQLDA)
PrototypeC.i isc_dsql_free_statement(*StatusVector, *QueryHandle, free_option.w)
PrototypeC.i isc_dsql_execute_immediate(*StatusVector, *dbHandle, *TransactionHandle, SQL_length.w, *SQLstring, Dialect.w, *XSQLDA)
PrototypeC.i isc_dsql_execute(*StatusVector, *TransactionHandle, *QueryHandle, da_version.w, *XSQLDA_IN)
PrototypeC.i isc_dsql_execute2(*StatusVector, *TransactionHandle, *QueryHandle, da_version.w, *XSQLDA_IN, *XSQLDA_OUT)
CompilerEndIf
;this is a C pointer on any platform
PrototypeC.i isc_start_transaction(*StatusVector, *TransactionHandle, Count.w, *dbHandle, TPBLength.w, *TPB)
Global fb_attach.isc_attach_database = GetFunction(#FB_Client, "isc_attach_database")
Global fb_detach.isc_detach_database = GetFunction(#FB_Client, "isc_detach_database")
Global fb_start.isc_start_transaction = GetFunction(#FB_Client, "isc_start_transaction")
Global fb_rollback.isc_rollback_transaction = GetFunction(#FB_Client, "isc_rollback_transaction")
Global fb_commit.isc_commit_transaction = GetFunction(#FB_Client, "isc_commit_transaction")
Global fb_allocate.isc_dsql_alloc_statement2 = GetFunction(#FB_Client, "isc_dsql_alloc_statement2")
Global fb_prepare.isc_dsql_prepare = GetFunction(#FB_Client, "isc_dsql_prepare")
Global fb_describe.isc_dsql_describe = GetFunction(#FB_Client, "isc_dsql_describe")
Global fb_describe_bind.isc_dsql_describe_bind = GetFunction(#FB_Client, "isc_dsql_describe_bind")
Global fb_error.fb_interpret = GetFunction(#FB_Client, "fb_interpret")
Global fb_sqlcode.isc_sqlcode = GetFunction(#FB_Client, "isc_sqlcode")
Global fb_sql_error.isc_sql_interpret = GetFunction(#FB_Client, "isc_sql_interprete")
Global fb_fetch.isc_dsql_fetch = GetFunction(#FB_Client, "isc_dsql_fetch")
Global fb_free.isc_dsql_free_statement = GetFunction(#FB_Client, "isc_dsql_free_statement")
Global fb_execute_immediate.isc_dsql_execute_immediate = GetFunction(#FB_Client, "isc_dsql_execute_immediate")
Global fb_execute.isc_dsql_execute = GetFunction(#FB_Client, "isc_dsql_execute")
Global fb_execute2.isc_dsql_execute2 = GetFunction(#FB_Client, "isc_dsql_execute2")
Procedure.i _buffer_size(nFields)
ProcedureReturn (nFields * SizeOf(XSQLVAR)) + SizeOf(XSQLDA) + 20
EndProcedure
Procedure _create_buffers(*sqlda_out, nFields.w)
nPos = *sqlda_out + SizeOf(XSQLDA)
For c = 1 To nFields
nSize = PeekW(nPos+OffsetOf(XSQLVAR\sqllen))
nSize = (nSize * 2) + 4
bnull = AllocateMemory(8)
PokeW(bnull, 0)
bfield = AllocateMemory(nSize)
PokeI(nPos+OffsetOf(XSQLVAR\sqlind), bnull)
PokeI(nPos+OffsetOf(XSQLVAR\sqldata), bfield)
nPos = nPos + SizeOf(XSQLVAR)
Next
EndProcedure
Procedure.i _describe(*sv, stmt, *sqlda_out, nFields.w)
_new_sqlda(*sqlda_out, nFields)
nResult = fb_describe(*sv, @stmt, 1, *sqlda_out)
If nResult = 0
_create_buffers(*sqlda_out, nFields)
nCheck = PeekW(*sqlda_out+OffsetOf(XSQLDA\sqld))
ProcedureReturn nCheck
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure _describe_bind(*sv, stmt, *sqlda_in, nFields.w)
_new_sqlda(*sqlda_in, nFields)
nResult = fb_describe_bind(*sv, @stmt, 1, *sqlda_in)
If nResult = 0
_create_buffers(*sqlda_in, nFields)
nCheck = PeekW(*sqlda_in+OffsetOf(XSQLDA\sqld))
ProcedureReturn nCheck
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i _execute(*sv, txh, stmt, *sqlda_in=#Null)
ProcedureReturn fb_execute(*sv, @txh, @stmt, #SQLDA_VERSION1, *sqlda_in)
EndProcedure
Procedure.s _extract_date(nDate.i)
Define.i nDiff = nDate - 40587 ; fb dates start @ 1858-11-17, PB @ 1970-01-01
ProcedureReturn FormatDate("%yyyy-%mm-%dd", AddDate(Date(1970,1,1,0,0,0), #PB_Date_Day, nDiff))
EndProcedure
Procedure.s _extract_time(nTime.i)
Define.i nHours, nMinutes, nSeconds
Define.s txt = ""
nHours = nTime / 36000000 : nTime - (nHours * 36000000)
txt + Right("00" + Str(nHours), 2) + ":"
nMinutes = nTime / 600000 : nTime - (nMinutes * 600000)
txt + Right("00" + Str(nMinutes), 2) + ":"
nSeconds = nTime / 10000
txt + Right("00" + Str(nSeconds), 2)
ProcedureReturn txt
EndProcedure
Procedure.i _field_string(*fld.fbField)
Select *fld\type
Case fb::#FB_SQL_TEXT
*fld\stringval = PeekS(*fld\buffer, *fld\size, #PB_UTF8)
*fld\pbtype = #PB_Database_String
Case fb::#FB_SQL_TEXT + 1
*fld\stringval = PeekS(*fld\buffer, *fld\size, #PB_UTF8)
*fld\pbtype = #PB_Database_String
Case fb::#FB_SQL_VARYING
*fld\stringval = PeekS(*fld\buffer, -1, #PB_UTF8)
*fld\pbtype = #PB_Database_String
Case fb::#FB_SQL_VARYING + 1
*fld\stringval = PeekS(*fld\buffer, -1, #PB_UTF8)
*fld\pbtype = #PB_Database_String
Case fb::#FB_SQL_FLOAT, fb::#FB_SQL_FLOAT + 1
*fld\stringval = StrF(PeekF(*fld\buffer))
*fld\pbtype = #PB_Database_Float
Case fb::#FB_SQL_D_FLOAT, fb::#FB_SQL_D_FLOAT + 1
*fld\stringval = StrF(PeekF(*fld\buffer))
*fld\pbtype = #PB_Database_Float
Case fb::#FB_SQL_DOUBLE, fb::#FB_SQL_DOUBLE + 1
*fld\stringval = StrD(PeekD(*fld\buffer))
*fld\pbtype = #PB_Database_Double
Case fb::#FB_SQL_INT64, fb::#FB_SQL_INT64 + 1, #FB_SQL_QUAD, #FB_SQL_QUAD + 1, #FB_SQL_LONG, #FB_SQL_LONG + 1
Define.q dRes = 0, dVal = PeekQ(*fld\buffer)
If *fld\scale = 0
*fld\stringval = Str(dVal)
*fld\pbtype = #PB_Database_Quad
Else
Define.i nLoop = 0, nDivisor = 1, nScale = *fld\scale * -1
While nLoop < nScale
nDivisor * 10
nLoop + 1
Wend
dRes = dVal / nDivisor
*fld\stringval = StrD(dRes, nScale)
*fld\pbtype = #PB_Database_Double
EndIf
Case fb::#FB_SQL_SHORT, fb::#FB_SQL_SHORT + 1
*fld\stringval = Str(PeekC(*fld\buffer))
*fld\pbtype = #PB_Database_Long
Case fb::#FB_SQL_TIMESTAMP, fb::#FB_SQL_TIMESTAMP + 1
*fld\stringval = _extract_date(PeekL(*fld\buffer))
*fld\stringval + " "
*fld\stringval + _extract_time(PeekL(*fld\buffer+4))
*fld\pbtype = #Null
Case fb::#FB_SQL_TYPE_DATE, fb::#FB_SQL_TYPE_DATE + 1
*fld\stringval = _extract_date(PeekL(*fld\buffer))
*fld\pbtype = #Null
Case fb::#FB_SQL_TYPE_TIME, fb::#FB_SQL_TYPE_TIME + 1
*fld\stringval = _extract_time(PeekL(*fld\buffer))
*fld\pbtype = #Null
Default
*fld\stringval = "Unsupported Type: " + Str(*fld\type)
*fld\pbtype = #Null
EndSelect
ProcedureReturn *fld
EndProcedure
Procedure _free_buffers(*bfr)
nFieldCount = PeekW(*bfr+OffsetOf(XSQLDA\sqld))
nPos = *bfr + SizeOf(XSQLDA)
For c = 1 To nFieldCount
bnull = PeekI(nPos+OffsetOf(XSQLVAR\sqlind))
bfield = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
FreeMemory(bnull)
FreeMemory(bfield)
nPos = nPos + SizeOf(XSQLVAR)
Next
FreeMemory(*bfr)
EndProcedure
Procedure.i _position_pointer(nFields)
nPos = (nFields-1) * SizeOf(XSQLVAR)
nPos = nPos + SizeOf(XSQLDA)
ProcedureReturn nPos
EndProcedure
Procedure _new_sqlda(*buffer, nFields.w, isparams=#False)
PokeW(*buffer+OffsetOf(XSQLDA\version), #SQLDA_VERSION1)
PokeS(*buffer+OffsetOf(XSQLDA\sqldaid), " ", 8, #PB_Ascii)
PokeL(*buffer+OffsetOf(XSQLDA\sqldabc), 0)
If isparams
PokeW(*buffer+OffsetOf(XSQLDA\sqln), 0)
PokeW(*buffer+OffsetOf(XSQLDA\sqld), nFields)
Else
PokeW(*buffer+OffsetOf(XSQLDA\sqln), nFields)
PokeW(*buffer+OffsetOf(XSQLDA\sqld), 0)
EndIf
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
PokeL(*buffer+OffsetOf(XSQLDA\wtf), 0)
CompilerEndIf
EndProcedure
Procedure.w _prepare(*sv, txh, stmt, sql.s)
*sqlda_out = AllocateMemory(_buffer_size(1))
_new_sqlda(*sqlda_out, 1)
nLen = StringByteLength(sql, #PB_UTF8)
*sqlbuffer = AllocateMemory(nLen+4)
PokeS(*sqlbuffer, sql, nLen, #PB_UTF8)
nResult = fb_prepare(*sv, @txh, @stmt, nLen, *sqlbuffer, #FB_SQL_DIALECT_V6, *sqlda_out)
FreeMemory(*sqlbuffer)
nFields.w = -1
If nResult = 0
nFields = PeekW(*sqlda_out+OffsetOf(XSQLDA\sqld))
EndIf
FreeMemory(*sqlda_out)
ProcedureReturn nFields
EndProcedure
Procedure.i Allocate(*sv, dbh)
stmt = #Null
nResult.i = fb_allocate(*sv, @dbh, @stmt)
If nResult = 0
ProcedureReturn stmt
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i Begin(*sv, dbh)
*TPB = AllocateMemory(4)
PokeB(*TPB, #isc_tpb_version3)
PokeB(*TPB + 1, #isc_tpb_write)
PokeB(*TPB + 2, #isc_tpb_concurrency)
PokeB(*TPB + 3, #isc_tpb_wait)
txh = #Null
nResult.i = fb_start(*sv, @txh, 1, @dbh, 4, *TPB)
FreeMemory(*TPB)
If nResult = 0
ProcedureReturn txh
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure BindDouble(*bfr, idx, itm.d)
nPos = *bfr + _position_pointer(idx)
nBfr = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
PokeD(nBfr, itm)
EndProcedure
Procedure BindFloat(*bfr, idx, itm.f)
nPos = *bfr + _position_pointer(idx)
nBfr = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
PokeF(nBfr, itm)
EndProcedure
Procedure.i BindInteger(*bfr, idx, itm)
nPos = *bfr + _position_pointer(idx)
nBfr = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
PokeI(nBfr, itm)
EndProcedure
Procedure.i BindNull(*bfr, idx)
nPos = *bfr + _position_pointer(idx)
nBfr = PeekI(nPos+OffsetOf(XSQLVAR\sqlind))
PokeW(nBfr, -1)
EndProcedure
Procedure.i BindString(*bfr, idx, itm.s)
nPos = *bfr + _position_pointer(idx)
nBfr = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
nLen.w = StringByteLength(itm, #PB_UTF8)
PokeW(nBfr, nLen)
PokeS(nBfr+2, itm, nLen, #PB_UTF8)
EndProcedure
Procedure.i Close(*sv, dbh)
nResult.i = fb_detach(*sv, @dbh)
If nResult = 0
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i Commit(*sv, txh)
nResult.i = fb_commit(*sv, @txh)
If nResult.i = 0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i Connect(*sv, DatabaseAlias$, Username$, Password$, Role$="")
nAlias.w = StringByteLength(DatabaseAlias$, #PB_UTF8)
*dbAlias = AllocateMemory(nAlias)
PokeS(*dbAlias, DatabaseAlias$, nAlias, #PB_UTF8|#PB_String_NoZero)
Param$ = Chr(#isc_dpb_version1)
nUN.w = StringByteLength(Username$, #PB_UTF8)
If nUN > 0 : Param$ + Chr(#isc_dpb_user_name) + Chr(nUN) + Username$ : EndIf
nPWD.w = StringByteLength(Password$, #PB_UTF8)
If nPWD > 0 : Param$ + Chr(#isc_dpb_password) + Chr(nPWD) + Password$ : EndIf
If Role$ <> ""
nRL.w = StringByteLength(Role$, #PB_UTF8)
If nRL > 0 : Param$ + Chr(#isc_dpb_sql_role_name) + Chr(nRL) + Role$ : EndIf
EndIf
nUN = StringByteLength("UTF8", #PB_UTF8)
Param$ + Chr(#isc_dpb_lc_ctype) + Chr(nUN) + "UTF8"
nUN = StringByteLength(Param$, #PB_UTF8)
*dbParam = UTF8(Param$)
dbh = #Null
nResult.i = fb_attach(*sv, nAlias, *dbAlias, @dbh, nUN, *dbParam)
FreeMemory(*dbAlias)
FreeMemory(*dbParam)
If nResult = 0
ProcedureReturn dbh
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i FetchNext(*sv, stmt, *sqlda_out)
ProcedureReturn fb_fetch(*sv, @stmt, 1, *sqlda_out)
EndProcedure
Procedure.i Free(*sv, stmt, *sqlda_out=#Null, *sqlda_in=#Null)
If *sqlda_out <> #Null
_free_buffers(*sqlda_out)
EndIf
If *sqlda_in <> #Null
_free_buffers(*sqlda_in)
EndIf
nRes = fb_free(*sv, @stmt, #DSQL_DROP)
If nRes = 0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure FreeField(*fld.fbField)
FreeStructure(*fld)
EndProcedure
Procedure.s FieldDate(*fld.fbField)
ProcedureReturn *fld\stringval
EndProcedure
Procedure.d FieldDouble(*fld.fbField)
ProcedureReturn ValD(*fld\stringval)
EndProcedure
Procedure.f FieldFloat(*fld.fbField)
ProcedureReturn ValF(*fld\stringval)
EndProcedure
Procedure.i FieldInteger(*fld.fbField)
ProcedureReturn Val(*fld\stringval)
EndProcedure
Procedure.q FieldQuad(*fld.fbField)
ProcedureReturn Val(*fld\stringval)
EndProcedure
Procedure.s FieldString(*fld.fbField)
ProcedureReturn *fld\stringval
EndProcedure
Procedure.s FieldTime(*fld.fbField)
ProcedureReturn *fld\stringval
EndProcedure
Procedure.s FieldTimeStamp(*fld.fbField)
ProcedureReturn *fld\stringval
EndProcedure
Procedure.s GetError(*sv)
ErrorMessage$ = ""
nResult.i = 1
While nResult <> 0
err = AllocateMemory(256)
nResult.i = fb_error(err, 256, @*sv)
ErrorMessage$ + PeekS(err, -1, #PB_UTF8) + #CRLF$
FreeMemory(err)
Wend
If ErrorMessage$ <> ""
ProcedureReturn ErrorMessage$
Else
err = AllocateMemory(256)
nSQLCode.w = fb_sqlcode(*sv)
If nSQLCode <> 0
ErrorMessage$ = "SQL Code: " + Str(nSQLCode)
fb_sql_error(nSQLCode, err, 256)
ErrorMessage$ + #CRLF$ + PeekS(err, -1, #PB_UTF8)
EndIf
FreeMemory(err)
ProcedureReturn ErrorMessage$
EndIf
EndProcedure
Procedure.i GetField(*bfr, idx)
nFieldCount = PeekW(*bfr+OffsetOf(XSQLDA\sqld))
If idx > nFieldCount
ProcedureReturn #Null
EndIf
nPos = *bfr + _position_pointer(idx)
nNameLength = PeekW(nPos+OffsetOf(XSQLVAR\sqlname_length))
sFieldName.s = PeekS(nPos+OffsetOf(XSQLVAR\sqlname), nNameLength, #PB_UTF8)
nIsNullP = PeekI(nPos+OffsetOf(XSQLVAR\sqlind))
nIsNull.w = PeekW(nIsNullP)
*fld.fbField = AllocateStructure(fbField)
*fld\name = sFieldName
*fld\size = PeekW(nPos+OffsetOf(XSQLVAR\sqllen))
*fld\scale = PeekW(nPos+OffsetOf(XSQLVAR\sqlscale))
*fld\type = PeekW(nPos+OffsetOf(XSQLVAR\sqltype))
*fld\subtype = PeekW(nPos+OffsetOf(XSQLVAR\sqlsubtype))
*fld\buffer = PeekI(nPos+OffsetOf(XSQLVAR\sqldata))
If *fld\type = #FB_SQL_VARYING Or *fld\type = #FB_SQL_VARYING + 1
*fld\length = PeekW(*fld\buffer)
*fld\buffer = *fld\buffer + 2
EndIf
If nIsNull = 0
*fld\isnull = #False
Else
*fld\isnull = #True
EndIf
ProcedureReturn _field_string(*fld)
EndProcedure
Procedure.i GetFieldCount(*bfr)
nFieldCount = PeekW(*bfr+OffsetOf(XSQLDA\sqld))
ProcedureReturn nFieldCount
EndProcedure
Procedure.i Prepare(*sv, txh, stmt, sql.s)
nFields = _prepare(*sv, txh, stmt, sql)
If nFields = -1 : ProcedureReturn #Null : EndIf
*sqlda_in = AllocateMemory(_buffer_size(1))
nFields = _describe_bind(*sv, stmt, *sqlda_in, 1)
If nFields = -1
FreeMemory(*sqlda_in)
ProcedureReturn #Null
Else
If nFields > 1
FreeMemory(*sqlda_in)
*sqlda_in = AllocateMemory(_buffer_size(nFields))
Res = _describe_bind(*sv, stmt, *sqlda_in, nFields)
If Res = -1
ProcedureReturn #Null
Else
ProcedureReturn *sqlda_in
EndIf
Else
ProcedureReturn *sqlda_in
EndIf
EndIf
EndProcedure
Procedure.i Rollback(*sv, txh)
Res = fb_rollback(*sv, @txh)
If Res = 0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i SQLExecute(*sv, dbh, txh, qry.s)
nSQL.i = StringByteLength(qry, #PB_UTF8) + 4
*sql = AllocateMemory(nSQL)
PokeS(*sql, qry, nSQL, #PB_UTF8)
Res = fb_execute_immediate(*sv, @dbh, @txh, nSQL, *sql, #FB_SQL_DIALECT_V6, #Null)
FreeMemory(*sql)
If Res = 0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i SQLExecuteP(*sv, txh, stmt, *sqlda_in)
Res = _execute(*sv, txh, stmt, *sqlda_in)
If Res = 0
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i SQLSelect(*sv, txh, stmt, sql.s)
nFields = _prepare(*sv, txh, stmt, sql)
If nFields = -1 Or nFields = 0 : ProcedureReturn #False : EndIf
*sqlda_out = AllocateMemory(_buffer_size(nFields))
Res = _describe(*sv, stmt, *sqlda_out, nFields)
If Res = -1
FreeMemory(*sqlda_out)
ProcedureReturn #False
EndIf
If _execute(*sv, txh, stmt) = 0
ProcedureReturn *sqlda_out
Else
FreeMemory(*sqlda_out)
ProcedureReturn #False
EndIf
EndProcedure
Procedure.i SQLSelectP(*sv, txh, stmt, *sqlda_in)
*sqlda_out = AllocateMemory(_buffer_size(1))
Res = _describe(*sv, stmt, *sqlda_out, 1)
If Res = -1
FreeMemory(*sqlda_out)
ProcedureReturn #False
EndIf
If Res > 1
FreeMemory(*sqlda_out)
*sqlda_out = AllocateMemory(_buffer_size(Res))
Res = _describe(*sv, stmt, *sqlda_out, Res)
If Res = -1
FreeMemory(*sqlda_out)
ProcedureReturn #False
EndIf
EndIf
Res = _execute(*sv, txh, stmt, *sqlda_in)
If Res = 0
ProcedureReturn *sqlda_out
Else
ProcedureReturn #Null
EndIf
EndProcedure
EndModule
mod-fbs-test.pb
Code: Select all
XIncludeFile "mod-fbs.pb"
Procedure HandleError(*sv,dbh=0,txh=0,stmt=0,*bfr=#Null)
Debug fb::GetError(*sv)
If txh > 0 : fb::Rollback(*sv,txh) : EndIf
If stmt > 0 : fb::Free(*sv,stmt,*bfr) : EndIf
If dbh > 0 : fb::Close(*sv,dbh) : EndIf
End
EndProcedure
sv.fb::ISC_STATUS
dbh = fb::Connect(@sv,"192.168.1.206:employee","sysdba","masterkey")
If Not dbh : HandleError(@sv) : EndIf
txh = fb::Begin(@sv,dbh)
If Not txh : HandleError(@sv,dbh) : EndIf
; do some updates
Res = fb::SQLExecute(@sv,dbh,txh,"UPDATE COUNTRY SET CURRENCY = 'Euro' WHERE COUNTRY = 'Italy'")
If Not Res : HandleError(@sv,dbh,txh) : EndIf
Res = fb::SQLExecute(@sv,dbh,txh,"UPDATE COUNTRY SET CURRENCY = 'Euro' WHERE COUNTRY = 'France'")
If Not Res : HandleError(@sv,dbh,txh) : EndIf
; update with parameters
stmt1 = fb::Allocate(@sv,dbh)
If Not stmt1 : HandleError(@sv,dbh,txh) : EndIf
*sqlda_in = fb::Prepare(@sv,txh,stmt1,"UPDATE COUNTRY SET CURRENCY = ? WHERE COUNTRY = ?")
If Not *sqlda_in : HandleError(@sv,dbh,txh) : EndIf
fb::BindString(*sqlda_in,1,"Euro")
fb::BindString(*sqlda_in,2,"Austria")
Res = fb::SQLExecuteP(@sv,txh,stmt1,*sqlda_in)
If Not Res : HandleError(@sv,dbh,txh,stmt1,*sqlda_in) : EndIf
fb::Free(@sv,stmt1,*sqlda_in)
; select some records and iterate over the recordset
stmt = fb::Allocate(@sv,dbh)
If Not stmt : HandleError(@sv,dbh,txh) : EndIf
*bfr = fb::SQLSelect(@sv,txh,stmt,"SELECT * FROM COUNTRY WHERE CURRENCY = 'Euro' ORDER BY CURRENCY")
If Not *bfr : HandleError(@sv,dbh,txh) : EndIf
recs = 0
nFieldCount = fb::GetFieldCount(*bfr)
Debug "Fields: " + Str(nFieldCount)
nFetch = #True
While nFetch
Res = fb::FetchNext(@sv,stmt,*bfr)
If Res = 100
nFetch = #False
ElseIf Res <> 0
HandleError(@sv,dbh,txh,stmt,*bfr)
Else
For c = 1 To nFieldCount
*fld.fb::fbField = fb::GetField(*bfr,c)
If recs = 0
Debug ""
Debug "Name: " + *fld\name
Debug "Size: " + Str(*fld\size)
Debug "Scale: " + Str(*fld\scale)
Debug "Type: " + Str(*fld\type)
Debug "Length: " + Str(*fld\length)
EndIf
; you could check *fld\type to know how to Peek but for this example I know it's a string
Debug *fld\name + ": " + PeekS(*fld\buffer,-1,#PB_UTF8)
;Debug "Null: " + Str(*fld\isnull)
FreeStructure(*fld)
Next
Debug ""
recs = recs + 1
EndIf
Wend
fb::Free(@sv,stmt,*bfr)
Debug "Records: " + Str(recs)
; select with parameters
stmt2 = fb::Allocate(@sv,dbh)
If Not stmt2 : HandleError(@sv,dbh,txh) : EndIf
*sqlda_in = fb::Prepare(@sv,txh,stmt2,"SELECT * FROM COUNTRY WHERE CURRENCY = ?")
If Not *sqlda_in : HandleError(@sv,dbh,txh) : EndIf
fb::BindString(*sqlda_in,1,"Pound")
*bfr = fb::SQLSelectP(@sv,txh,stmt2,*sqlda_in)
If Not *bfr : HandleError(@sv,dbh,txh,stmt2,*sqlda_in) : EndIf
nFetch = #True
While nFetch
Res = fb::FetchNext(@sv,stmt2,*bfr)
If Res = 100
nFetch = #False
ElseIf Res <> 0
HandleError(@sv,dbh,txh,stmt2,*bfr)
Else
For c = 1 To nFieldCount
*fld.fb::fbField = fb::GetField(*bfr,c)
Debug *fld\name + ": " + PeekS(*fld\buffer,-1,#PB_UTF8)
FreeStructure(*fld)
Next
EndIf
Wend
fb::Free(@sv,stmt,*bfr,*sqlda_in)
If Not fb::Commit(@sv,txh) : HandleError(@sv,dbh,txh) : EndIf
fb::Close(@sv,dbh)
If you run it with Firebird Server version < 2.5 you might have issues with encodings other than utf8 but with >= 2.5 hopefully it should just work.
I understand as of v 3.0 Firebird's client library includes the database engine so you can use exactly the same code for accessing a local embedded database as you do for a client/server configuration, the only thing that changes is the initial connection string.
# Edit 2021-10-24: Fixed logic error