FB ODBC Library

User projects written in or related to FreeBASIC.
KaraK
Posts: 72
Joined: Sep 13, 2006 19:01
Location: Argentina

FB ODBC Library

Postby KaraK » Jul 08, 2007 7:48

Well, i've ported/adapted/modified a set of 3 odbc classes by 'TomKat' (http://www.codeproject.com/database/ODBC.asp)

Supports odbc connection for mssql , dBASE, MS Excel, MS FOX, MS Access, MySQL and Text db (through text driver)

for FB 0.17b -lang fb

FBODBC.bi :

Code: Select all

'*************************************************************
' FB ODBC Library
'
'by Leonardo Neumann aka 'KaraK'
'karak.neumann at gmail dot com
'*************************************************************

#Include Once "win/sqltypes.bi"
#Include Once "win/sql.bi"
#Include Once "win/sqlext.bi"
#Include Once "win/odbcinst.bi"

Namespace FBODBC

Enum EnumProtocols
protoNamedPipes
protoWinSock
protoIPX
protoBanyan
protoRPC
End Enum


'Object
Type ODBCConnection
   
Public:
   Declare Constructor()
   Declare Destructor()
   Declare Function Connect(svSource As String) As Boolean
   Declare Function ConnectDSN(DSN As String,User as String="",Pass As String="") As Boolean
   Declare Sub Disconnect()
   Declare Function DBC() As HDBC
   
   'MSSQL
   Declare Function MSSQLConnect(User As String,Pass As String,Host As String = "(local)",Trusted As Boolean = TRUE,Proto As EnumProtocols = protoNamedPipes) As Boolean
   'dBASE
   Declare Function DB2Connect(DBPath As String) As Boolean
   'MS Excel
   Declare Function XLSConnect(XLSPath As String,DefDir As String = "") As Boolean
   'Text
   Declare Function TXTConnect(TXTPath As String) As Boolean
   'MS FOX
   Declare Function FOXConnect(DBPath As String,User As String = "",Pass As String = "",SrcType As String = "DBF",Exclusive As Boolean = FALSE) As Boolean
   'MS Access
   Declare Function MDBConnect(MDBPath As String,User As String = "",Pass As String = "",Exclusive As Boolean = FALSE) As Boolean
   'MySQL
   Declare Function MySQLConnect(User As String = "",Pass As String = "",Host As String = "localhost",Port As UInteger = 3306) As Boolean
   Declare Function MySQLConnectDB(DB As String,User As String = "",Pass As String = "",Host As String = "localhost",Port As UInteger = 3306) As Boolean
      
Private:
   m_nReturn As SQLRETURN   'Internal SQL Error code
   m_hEnv As HENV            'Handle to environment
   m_hDBC As HDBC            'Handle to database connection
   
End Type

Constructor ODBCConnection()
this.m_hDBC = NULL
this.m_hEnv = NULL
this.m_nReturn = SQL_ERROR
End Constructor

Destructor ODBCConnection()
If this.m_hDBC <> NULL Then
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_DBC,this.m_hDBC)
EndIf

If this.m_hEnv <> NULL Then
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_ENV,this.m_hEnv)
EndIf
End Destructor

Function ODBCConnection.Connect(svSource As String) As Boolean
Dim nConnect As Integer
   
nConnect = SQLAllocHandle(SQL_HANDLE_ENV,SQL_NULL_HANDLE,@this.m_hEnv)

if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
   
   nConnect = SQLSetEnvAttr(this.m_hEnv,SQL_ATTR_ODBC_VERSION,CPtr(Any ptr,SQL_OV_ODBC3),0)
   
   if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
      
      nConnect = SQLAllocHandle(SQL_HANDLE_DBC,this.m_hEnv,@this.m_hDBC)
      
      if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
         
         SQLSetConnectOption( this.m_hDBC,SQL_LOGIN_TIMEOUT,5 )
         
         Dim shortResult As Short = 0
         Dim szOutConnectString(1023) As SQLTCHAR
         
         nConnect = SQLDriverConnect(m_hDBC,_   'Conn Handle
         NULL,_                                 'window handle
         CPtr(SQLTCHAR ptr,StrPtr(svSource)),_   'InConnectionString
         Len(svSource),_                        'StringLEnght1
         @szOutConnectString(0),_                     'OutConnectionString
         SizeOf(szOutConnectString),_            'Buff len
         @shortResult,_                           'StringLenght2Ptr
         SQL_DRIVER_NOPROMPT)                     'no user prompt
         
         if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
            Return TRUE
         Else
            Return FALSE
         EndIf
         
      EndIf
      
   EndIf

EndIf

If this.m_hDBC <> NULL Then
   this.m_nReturn = SQLDisconnect(this.m_hDBC)
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_DBC,this.m_hDBC)
EndIf

If this.m_hEnv <> NULL Then
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_ENV,this.m_hEnv)
   this.m_hDBC = NULL
   this.m_hEnv = NULL
   this.m_nReturn = SQL_ERROR
EndIf
   
Return FALSE

End Function

Function ODBCConnection.ConnectDSN(DSN As String,User As String = "",Pass As String="") As Boolean
Dim nConnect As Integer

nConnect = SQLAllocHandle(SQL_HANDLE_ENV,SQL_NULL_HANDLE,@this.m_hEnv)

if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
   
   nConnect = SQLSetEnvAttr(this.m_hEnv,SQL_ATTR_ODBC_VERSION,SQL_OV_ODBC3,SQL_IS_INTEGER)
   
   if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
      
      nConnect = SQLAllocHandle(SQL_HANDLE_DBC,this.m_hEnv,@this.m_hDBC)
      
      if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
         
         SQLSetConnectOption( this.m_hDBC,SQL_LOGIN_TIMEOUT,5 )
            
         Dim shortResult As Short = 0
         Dim szOutConnectString(1023) As SQLTCHAR
         
         nConnect = SQLConnect(this.m_hDBC,_
         StrPtr(DSN),_
         SQL_NTS,_
         StrPtr(User),_
         SQL_NTS,_
         StrPtr(Pass),_
         SQL_NTS)                     'no user prompt

         if nConnect = SQL_SUCCESS Or nConnect = SQL_SUCCESS_WITH_INFO Then
            Return TRUE
         Else
            Return FALSE
         EndIf
         
      EndIf
      
   EndIf

EndIf

If this.m_hDBC <> NULL Then
   this.m_nReturn = SQLDisconnect(this.m_hDBC)
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_DBC,this.m_hDBC)
EndIf

If this.m_hEnv <> NULL Then
   this.m_nReturn = SQLFreeHandle(SQL_HANDLE_ENV,this.m_hEnv)
   this.m_hDBC = NULL
   this.m_hEnv = NULL
   this.m_nReturn = SQL_ERROR
EndIf
   
Return FALSE
End Function

Sub ODBCConnection.Disconnect()
if this.m_hDBC <> NULL Then
   this.m_nReturn = SQLDisconnect( this.m_hDBC )
   this.m_hDBC = NULL
EndIf
End Sub

Function ODBCConnection.DBC() As HDBC
   Return this.m_hDBC
End Function

Function ODBCConnection.MSSQLConnect(User As String,Pass As String,Host As String = "(local)",Trusted As Boolean = TRUE,Proto As EnumProtocols = protoNamedPipes) As Boolean

Dim tstr As String
Dim szTrusted As String

If Trusted = TRUE Then
   szTrusted = "Yes"
Else
   szTrusted = "No"
EndIf

tstr = "Driver={SQL Server};Server=" & Host & _
         ";Uid=" & User & _
         ";Pwd=" & Pass & _
         ";Trusted_Connection=" & szTrusted & _
         ";Network="
         
Select Case Proto
   Case protoNamedPipes
      tstr = tstr & "dbnmpntw;"
   Case protoWinSock
      tstr = tstr & "dbmssocn;"
   Case protoIPX
      tstr = tstr & "dbmsspxn;"
   Case protoBanyan
      tstr = tstr & "dbmsvinn;"
   Case protoRPC
      tstr = tstr & "dbmsrpcn;"
   Case Else
      tstr = tstr & "dbmssocn;"
End Select

Return this.Connect(tstr)
   
End Function

Function ODBCConnection.DB2Connect(DBPath As String) As Boolean
Dim tstr As String

tstr = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & DBPath & ";"

Return this.Connect(tstr)

End Function

Function ODBCConnection.XLSConnect(XLSPath As String,DefDir As String = "") As Boolean
Dim tstr As String

tstr = "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;" & _
         "bq=" & DefDir & ";DefaultDir=" & XLSPath & ";"

Return this.Connect(tstr)

End Function

Function ODBCConnection.TXTConnect(TXTPath As String) As Boolean
Dim tstr As String

tstr = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
          "Dbq=" & TXTPath & ";Extensions=asc,csv,tab,txt;"

Return this.Connect(tstr)

End Function

Function ODBCConnection.FOXConnect(DBPath As String,User As String = "",Pass As String = "",SrcType As String = "DBF",Exclusive As Boolean = FALSE) As Boolean
Dim tstr As String
Dim bExcl As String

If Exclusive = TRUE Then
   bExcl = "Yes"
Else
   bExcl = "No"
EndIf

tstr = "Driver={Microsoft Visual Foxpro Driver};" & _
          "Uid=" & User & _
          ";Pwd=" & Pass & _
          ";SourceDB=" & DBPath & _
          ";SourceType=" & SrcType & _
          ";Exclusive=" & bExcl & ";"
         
Return this.Connect(tstr)

End Function

Function ODBCConnection.MDBConnect(MDBPath As String,User As String = "",Pass As String = "",Exclusive As Boolean = FALSE) As Boolean
Dim tstr As String
Dim bExcl As String

If Exclusive = TRUE Then
   bExcl = "Yes"
Else
   bExcl = "No"
EndIf

tstr = "Driver={Microsoft Access Driver (*.mdb)};" & _
         "Dbq=" & MDBPath & _
         ";Uid=" & User & _
         ";Pwd=" & Pass & _
         ";Exclusive=" & bExcl & ";"
         
Return this.Connect(tstr)

End Function

Function ODBCConnection.MySQLConnect(User As String = "",Pass As String = "",Host As String = "localhost",Port As UInteger = 3306) As Boolean
Dim tstr As String

tstr = "Driver={MySQL ODBC 3.51 Driver};" & _
         "Uid=" & User &_
         ";Pwd=" & Pass &_
         ";Server=" & Host &_
         ";Port=" & Port & ";"
         
Return this.Connect(tstr)

End Function

Function ODBCConnection.MySQLConnectDB(DB As String,User As String = "",Pass As String = "",Host As String = "localhost",Port As UInteger = 3306) As Boolean
Dim tstr As String

tstr = "Driver={MySQL ODBC 3.51 Driver};" & _
         "Database=" & DB &_
         ";Uid=" & User &_
         ";Pwd=" & Pass &_
         ";Server=" & Host &_
         ";Port=" & Port & ";"
         
Return this.Connect(tstr)

End Function
   

'Statement***************************

Type ODBCStmt
   
   m_hStmt As HSTMT
   
   Public:
   
   Declare Constructor(hDBCLink As HDBC)
   Declare Destructor()
   
   Declare Function IsValid() As Boolean
   Declare Function GetColumnCount() As UShort
   Declare Function GetChangedRowCount() As UInteger
   Declare Function Query(strSQL As String) As Boolean   
   Declare Function Fetch() As Boolean
   Declare Function FetchPrevious() As Boolean
   Declare Function FetchNext() As Boolean
   Declare Function FetchRow(nRow As UInteger,bAbsolute As Boolean = TRUE) As Boolean
   Declare Function FetchFirst() As Boolean
   Declare Function FetchLast() As Boolean
   Declare Function GotoRow(nRow As UInteger) As Boolean
   Declare Function Cancel() As Boolean

   
End Type

Constructor ODBCStmt(hDBCLink As HDBC)
Dim m_nReturn As SQLRETURN

m_nReturn = SQLAllocHandle(SQL_HANDLE_STMT,hDBCLink,@this.m_hStmt)

If m_nReturn = SQL_SUCCESS Or m_nReturn = SQL_SUCCESS_WITH_INFO Then

Else
   this.m_hStmt = Cast(HSTMT,INVALID_HANDLE_VALUE)
EndIf

End Constructor

Destructor ODBCStmt()
If this.m_hStmt <> INVALID_HANDLE_VALUE Then
   SQLFreeHandle(SQL_HANDLE_STMT,this.m_hStmt)
EndIf
End Destructor

Function ODBCStmt.IsValid() As Boolean
If this.m_hStmt = INVALID_HANDLE_VALUE Then
   Return FALSE
Else
   Return TRUE
EndIf
End Function

Function ODBCStmt.GetColumnCount() As UShort
Dim nCols As Short = 0
Dim nRet As SQLRETURN

nRet = SQLNumResultCols(this.m_hStmt,@nCols)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return nCols
Else
   Return 0
EndIf
End Function

Function ODBCStmt.GetChangedRowCount() As UInteger
Dim nRows As UInteger = 0
Dim nRet As SQLRETURN

nRet = SQLRowCount(this.m_hStmt,@nRows)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return nRows
Else
   Return 0
EndIf

End Function

Function ODBCStmt.Query(strSQL As String) As Boolean
Dim nRet As SQLRETURN

nRet = SQLExecDirect(this.m_hStmt,StrPtr(strSQL),SQL_NTS)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCStmt.Fetch() As Boolean
Dim nRet As SQLRETURN

nRet = SQLFetch(this.m_hStmt)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf

End Function

Function ODBCStmt.FetchPrevious() As Boolean
Dim nRet As SQLRETURN
Dim stmt As HSTMT

stmt = this.m_hStmt
nRet = SQLFetchScroll(stmt,SQL_FETCH_PRIOR,0)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function
   
Function ODBCStmt.FetchNext() As Boolean
Dim nRet As SQLRETURN
Dim stmt As HSTMT

stmt = this.m_hStmt
nRet = SQLFetchScroll(stmt,SQL_FETCH_NEXT,0)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function
   
Function ODBCStmt.FetchRow(nRow As UInteger,bAbsolute As Boolean = TRUE) As Boolean
Dim nRet As SQLRETURN

nRet=SQLFetchScroll(this.m_hStmt,IIf(bAbsolute,SQL_FETCH_ABSOLUTE,SQL_FETCH_RELATIVE),nRow)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCStmt.FetchFirst() As Boolean
Dim nRet As SQLRETURN
Dim stmt As HSTMT

stmt = this.m_hStmt
nRet = SQLFetchScroll(stmt,SQL_FETCH_FIRST,0)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCStmt.FetchLast() As Boolean
Dim nRet As SQLRETURN
Dim stmt As HSTMT

stmt = this.m_hStmt
nRet = SQLFetchScroll(stmt,SQL_FETCH_LAST,0)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCStmt.GotoRow(nRow As UInteger) As Boolean
Dim nRet As SQLRETURN

nRet = SQLSetPos(this.m_hStmt,nRow,SQL_POSITION,SQL_LOCK_NO_CHANGE)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCStmt.Cancel() As Boolean
Dim nRet As SQLRETURN

nRet = SQLCancel(this.m_hStmt)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

'Record***************************

Type ODBCRecord
   m_hStmt As HSTMT
   
   Public:
   
   Declare Constructor(hStmt As HSTMT)
   Declare Destructor()
   
   Declare Function GetColumnCount() As UShort
   Declare Function BindColumn(Column As UShort,pBuffer As UByte ptr,BufferSize As UInteger,pReturnedBufferSize As UInteger ptr = NULL,nType As UShort = SQL_C_TCHAR) As Boolean
   Declare Function GetColumnByName(Column As String) As UShort
   Declare Function GetData(Column As UShort,pBuffer As UByte ptr,BufLen As Integer,pDataLen As UInteger ptr = NULL,nType As Integer = SQL_C_DEFAULT) As Boolean
   Declare Function GetColumnType(Column As UShort) As Integer
   Declare Function GetColumnSize(Column As UShort) As UInteger
   Declare Function GetColumnScale(Column As UShort) As UInteger
   Declare Function GetColumnName(Column As UShort) As String
   Declare Function IsColumnNullable(Column As UShort) As Boolean
      
End Type

Constructor ODBCRecord(hStmt As HSTMT)
this.m_hStmt = hStmt
End Constructor

Destructor ODBCRecord()

End Destructor

Function ODBCRecord.GetColumnCount() As UShort
Dim nCols As Short = 0
Dim nRet As SQLRETURN

nRet = SQLNumResultCols(this.m_hStmt,@nCols)

If nRet = SQL_SUCCESS Or nRet = SQL_SUCCESS_WITH_INFO Then
   Return nCols
Else
   Return 0
EndIf
End Function

Function ODBCRecord.BindColumn(Column As UShort,pBuffer As UByte ptr,BufferSize As UInteger,pReturnedBufferSize As UInteger ptr = NULL,nType As UShort = SQL_C_CHAR) As Boolean
Dim pReturnedSize As UInteger = 0
Dim Ret As SQLRETURN

Ret = SQLBindCol(this.m_hStmt,Column,nType,pBuffer,BufferSize,@pReturnedSize)
   If pReturnedBufferSize <> NULL Then
      *pReturnedBufferSize=pReturnedSize
   EndIf
   
If Ret = SQL_SUCCESS Or Ret = SQL_SUCCESS_WITH_INFO Then
   Return TRUE
Else
   Return FALSE
EndIf
End Function

Function ODBCRecord.GetColumnName(Column As UShort) As String
Dim nType As Integer = SQL_C_DEFAULT
Dim svColName As ZString * 256
Dim As Short swCol = 0,swType = 0,swScale = 0,swNull = 0
Dim pcbColDef As UInteger = 0
Dim Ret As SQLRETURN

Ret = SQLDescribeCol( this.m_hStmt,_' Statement handle
       Column,_                  ' ColumnNumber
       @svColName,_                  ' ColumnName
       SizeOf(svColName),_                  ' BufferLength
       @swCol,_                  ' NameLengthPtr
       @swType,_                  ' DataTypePtr
       @pcbColDef,_               ' ColumnSizePtr
       @swScale,_                  ' DecimalDigitsPtr
       @swNull )                  ' NullablePtr
       
If Ret = SQL_SUCCESS Or Ret = SQL_SUCCESS_WITH_INFO Then
   Return svColName
Else
   Return ""
EndIf

End Function

Function ODBCRecord.GetColumnByName(Column As String) As UShort
Dim nCols As Short
Dim i As UShort

nCols = this.GetColumnCount()

For i = 1 To nCols+1
   Dim ColName As ZString * 256
   ColName = this.GetColumnName(i)
   If StrCmp(@ColName,StrPtr(Column)) = 0 Then
      Return i
   EndIf
Next

   Return 0
End Function

Function ODBCRecord.GetData(Column As UShort,pBuffer As UByte ptr,BufLen As Integer,pDataLen As UInteger ptr = NULL,nType As Integer = SQL_C_DEFAULT) As Boolean
Dim od As UInteger = 0
Dim nErr As Integer

nErr = SQLGetData(this.m_hStmt,Column,nType,pBuffer,BufLen,@od)
   
If nErr = SQL_SUCCESS Or nErr = SQL_SUCCESS_WITH_INFO Then
   If pDataLen <> NULL Then
      *pDataLen = od
   EndIf
   Return TRUE
Else
   Return FALSE
EndIf

End Function

Function ODBCRecord.GetColumnType(Column As UShort) As Integer
Dim nType As Integer = SQL_C_DEFAULT
Dim svColName As ZString * 256
Dim As Short swCol = 0,swType = 0,swScale = 0,swNull = 0
Dim pcbColDef As UInteger = 0
Dim Ret As SQLRETURN

SQLDescribeCol( this.m_hStmt,_' Statement handle
       Column,_                  ' ColumnNumber
       @svColName,_                  ' ColumnName
       SizeOf(svColName),_                  ' BufferLength
       @swCol,_                  ' NameLengthPtr
       @swType,_                  ' DataTypePtr
       @pcbColDef,_               ' ColumnSizePtr
       @swScale,_                  ' DecimalDigitsPtr
       @swNull )                  ' NullablePtr
 
nType = Cast(Integer,swType)

Return nType   

End Function

Function ODBCRecord.GetColumnSize(Column As UShort) As UInteger
Dim nType As Integer = SQL_C_DEFAULT
Dim svColName As ZString * 256
Dim As Short swCol = 0,swType = 0,swScale = 0,swNull = 0
Dim pcbColDef As UInteger = 0
Dim Ret As SQLRETURN

SQLDescribeCol( this.m_hStmt,_' Statement handle
       Column,_                  ' ColumnNumber
       @svColName,_                  ' ColumnName
       SizeOf(svColName),_                  ' BufferLength
       @swCol,_                  ' NameLengthPtr
       @swType,_                  ' DataTypePtr
       @pcbColDef,_               ' ColumnSizePtr
       @swScale,_                  ' DecimalDigitsPtr
       @swNull )                  ' NullablePtr
 
nType = Cast(Integer,swType)

Return pcbColDef
End Function

Function ODBCRecord.GetColumnScale(Column As UShort) As UInteger
Dim nType As Integer = SQL_C_DEFAULT
Dim svColName As ZString * 256
Dim As Short swCol = 0,swType = 0,swScale = 0,swNull = 0
Dim pcbColDef As UInteger = 0
Dim Ret As SQLRETURN

SQLDescribeCol( this.m_hStmt,_' Statement handle
       Column,_                  ' ColumnNumber
       @svColName,_                  ' ColumnName
       SizeOf(svColName),_                  ' BufferLength
       @swCol,_                  ' NameLengthPtr
       @swType,_                  ' DataTypePtr
       @pcbColDef,_               ' ColumnSizePtr
       @swScale,_                  ' DecimalDigitsPtr
       @swNull )                  ' NullablePtr

Return swScale
End Function

Function ODBCRecord.IsColumnNullable(Column As UShort) As Boolean
Dim nType As Integer = SQL_C_DEFAULT
Dim svColName As ZString * 256
Dim As Short swCol = 0,swType = 0,swScale = 0,swNull = 0
Dim pcbColDef As UInteger = 0
Dim Ret As SQLRETURN

SQLDescribeCol( this.m_hStmt,_' Statement handle
       Column,_                  ' ColumnNumber
       @svColName,_                  ' ColumnName
       SizeOf(svColName),_                  ' BufferLength
       @swCol,_                  ' NameLengthPtr
       @swType,_                  ' DataTypePtr
       @pcbColDef,_               ' ColumnSizePtr
       @swScale,_                  ' DecimalDigitsPtr
       @swNull )                  ' NullablePtr
 
If swNull = SQL_NULLABLE Then
   Return TRUE
Else
   Return FALSE
EndIf

End Function

End Namespace


OdbcTest.bas :

Code: Select all

#Include Once "windows.bi"
#Include Once "crt.bi"
#Include Once "FBODBC.bi"

Dim DBLink as FBODBC.ODBCConnection ptr
Dim DBStmt as FBODBC.ODBCStmt ptr
Dim DBRecord as FBODBC.ODBCRecord ptr

DBLink = New FBODBC.ODBCConnection

If DBLink->MSSQLConnect("sa","123456","(local)") = FALSE then
?"Error connecting to mssql"
Endif

DBStmt = New FBODBC.ODBCStmt(DBLink->DBC()) 'create new statement object , passing connection handle to the constructor

'querying the database...
DBStmt->Query("USE NorthWind")
DBStmt->Query("Select * From [Customers]")

'new Record object linked to the statement
DBRecord = New FBODBC.ODBCRecord(DBStmt->m_hStmt)

Dim CustomerID as ZString * 5

DBRecord->BindColumn(1,@CustomerID,5) 'bind first column to a buffer
DBStmt->FetchFirst() 'go to first row set
?CustomerID
DBStmt->FetchNext() ' go to next row set
?CustomerID
DBStmt->FetchLast() 'go to last row set
?CustomerID
DBStmt->FetchPrevious() 'go to previous row set
?CustomerID

Dim CompanyName as ZString * 41
DBRecord->GetData(2,@CompanyName,41) 'Get data from the second column without bind it
?CompanyName

?DBStmt->GetChangedRowCount() 'get row count

Delete DBRecord
Delete DBStmt
Delete DBLink

Sleep


i hope someone find it useful
Last edited by KaraK on Aug 24, 2007 3:40, edited 2 times in total.
djthain
Posts: 36
Joined: Mar 31, 2006 1:53

FreeBasic .16b

Postby djthain » Jul 14, 2007 1:56

I like the interface you wrote for odbc. I tried experimenting with my FoxPro files and it worked very well but when I tried to adapt FreeBasic .17b with my programs I had problems. I went back to FreeBasic .16b.
zerospeed
Posts: 227
Joined: Nov 04, 2005 15:29

Postby zerospeed » Jul 14, 2007 17:09

Great work KaraK!

I would suggest done some magical casting (cast operator) to avoid entering in the internal details of the connection.

From:

Code: Select all

'new Record object linked to the statement
DBRecord = New FBODBC.ODBCRecord(DBStmt->m_hStmt)


To:

Code: Select all

'new Record object linked to the statement
DBRecord = New FBODBC.ODBCRecord(DBStmt)


Since DBStmt is a UDT, and could be added some cast operator overloading as HSTMT ptr maybe?

Just an idea :-P

Congrats again, excellent job!
KaraK
Posts: 72
Joined: Sep 13, 2006 19:01
Location: Argentina

Postby KaraK » Jul 15, 2007 15:40

thanks for the feedback , i though noone will reply :P

nice idea zerospeed , ill try to do it in my free time ^^

by now , ive added ConnectDSN to ODBCConnection Type.
you can connect to the db using previously created System DSN
MystikShadows
Posts: 596
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Jul 15, 2007 17:13

Very nice port KaraK, well done.

I already have precisely 1013 uses for it already and I just finished reading this thread LOL.
djthain
Posts: 36
Joined: Mar 31, 2006 1:53

insert etc

Postby djthain » Jul 28, 2007 19:23

Is there any way to create insert, delete, update, and index using this interface?
SamSpade
Posts: 4
Joined: Aug 18, 2007 12:43
Location: London, United Kingdom

Re: insert etc

Postby SamSpade » Aug 23, 2007 9:45

djthain wrote:Is there any way to create insert, delete, update, and index using this interface?


Using the example above:

DBStmt->Query("INSERT INTO ...")
KaraK
Posts: 72
Joined: Sep 13, 2006 19:01
Location: Argentina

Postby KaraK » Aug 24, 2007 3:38

uhm , djthain must be referring to full OOP class manipulation of the recordsets/databases (like in vb)

well , its a good idea to get in.

btw , im having some problems with the library in windows 2003 boxes , i cant connect to mssql (error raises while doing SQLConnect() also with SQLConnectDriver in DSN connection) anyone else is having this problem ?


I've updated the code to get resultsets when executing any SP (default statement handle attributes by any reason were not let you get the resultsets).
SamSpade
Posts: 4
Joined: Aug 18, 2007 12:43
Location: London, United Kingdom

Postby SamSpade » Dec 12, 2007 12:13

Is there a version that works with 0.18 coming ??
yetifoot
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:

Postby yetifoot » Dec 13, 2007 11:33

SamSpade wrote:Is there a version that works with 0.18 coming ??


Hi Sam, I don't have windows to test this code, but as it was made in 0.17 it should be very close to working...

Can you post the actual errors you get, and I may be able to spot the problem.
wallyfblu
Posts: 69
Joined: May 24, 2006 10:58
Location: ITALY

Postby wallyfblu » Dec 13, 2007 15:50

Hi SamSpade, I'm using 0.18.3 on windows XP and I compile and run it without problems. For my purpose I create two system DSN and used
something like this

Code: Select all

DBLink = New FBODBC.ODBCConnection
If DBLink->ConnectDSN("xxxx","yyyy","zzzz") = FALSE Then
    LST.AddString("Connection Error",0)
    Print #1,"Connection Error"
    End_ODBC
Else
    LST.AddString("Connected to MAGAUT:)",0)
    Print #1,"Connected to MAGAUT:)"
Endif


Maybe this can help you.
If you have more specific questions, I can try to help you.
wallyfblu
Posts: 69
Joined: May 24, 2006 10:58
Location: ITALY

Postby wallyfblu » Jan 09, 2008 15:49

I have used this library to connect to a Oracle DB on a linux machine and all querys works fine.

With the count statement I have an empty string.
I used Oracle Sql Plus for test the query and I receive the right answer

Any idea?


a piece of code:

Code: Select all


If DBStmt->Query("select count(*) from udc where ud_area ='AA'")=FALSE Then
'                     SDLNet_TCP_Send(client_socket(x).socket,Strptr("error"),PACKET_LEN)
                     SDLNet_TCP_Send(client_socket(x).socket,Strptr("wsnomore"),PACKET_LEN)
                     Delete DBRecord
                     Delete DBStmt
                     Delete DBLink
                     Start_ODBC
                  Else
'                     MyQuery(client_socket(x).socket)
                     NewQuery(client_socket(x).socket)
                  EndIf    


Sub NewQuery(clsock As TCPSocket)

   Dim As Integer ncol,k,bytes
   Dim As ZString * PACKETLEN+1 zp,total

   ncol=DBStmt->GetColumnCount
   Do while DBStmt->Fetch() <> NULL
      total=""
      For k=1 To ncol
         If DBRecord->GetData(k,@zp,PACKETLEN) =FALSE Then
            MessageBox(NULL,"no data","FB",MB_OK)
         Else
            'Write zp
            'Print DBRecord->GetColumnName(k),DBRecord->GetColumnType(k)
         EndIf
         total=total+Trim(zp)+"&"
      Next
      bytes=SDLNet_TCP_Send(clsock,@total,PACKETLEN)
      If bytes < PACKETLEN Then
         Print "From Newquery: Not all sent",*SDLNet_GetError
         Print #1,"From Newquery: Not all sent",*SDLNet_GetError
      End If
      Sleep 1
   Loop
   zp="wsnomore"
   If (PACKETLEN > SDLNet_TCP_Send(clsock,@zp,PACKETLEN)) Then
      Print "From Newquery2: Not all sent"
      Print #1,"From Newquery2: Not all sent"
   EndIf         

End Sub
SamSpade
Posts: 4
Joined: Aug 18, 2007 12:43
Location: London, United Kingdom

Postby SamSpade » Oct 28, 2008 15:08

Sorry for not coming back to this earlier but I've been in the process of moving house and jobs and finally I'm back onto this.

The connection seems to work fine for me, and querying doesn't cause a particular error, but my result always comes back blank. Can anyone see if I am missing something obvious? Here's an excerpt of my code:

Code: Select all

#Include Once "windows.bi"
#Include Once "crt.bi"
#Include Once "FBODBC.bi"

Const DBCONN="test"
Const DBUSER="myuser"
Const DBPASS="mypass"

Dim DBLink As FBODBC.ODBCConnection Ptr
Dim DBStmt As FBODBC.ODBCStmt Ptr
Dim DBRecord As FBODBC.ODBCRecord Ptr

DBLink = New FBODBC.ODBCConnection

DBLink->ConnectDSN(DBCONN,DBUSER,DBPASS)
DBStmt = New FBODBC.ODBCStmt(DBLink->DBC())
DBStmt->Query("USE mydb")
DBStmt->Query("SELECT COUNT(ID) AS num FROM mytable")
DBRecord = New FBODBC.ODBCRecord(DBStmt->m_hStmt)
   
Dim DBNumRows As Zstring * 10
DBRecord->BindColumn(1,@DBNumRows,10)
DBStmt->FetchFirst()
? DBNumRows
Sleep


As mentioned this works fine and various checks have proved that everything works without returning an error but when I print the variable it is always empty.

Thanks
John Spikowski
Posts: 453
Joined: Dec 24, 2005 2:32
Location: WA - USA
Contact:

Postby John Spikowski » Oct 30, 2008 10:24

If your not getting paid by the line, check out this ODBC example.

http://www.allbasic.info/forum/index.php?topic=46.0


John
KaraK
Posts: 72
Joined: Sep 13, 2006 19:01
Location: Argentina

Postby KaraK » Nov 03, 2008 0:54

@SamSpade:

change DBStmt->FetchFirst() to DBStmt->Fetch()

fetchscroll api is returning false , and i dont know the reason why , i will check it when i have time.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 1 guest