Attribute VB_Name = "DBfunc"
'== 聲明odbc32.dll中定義的ODBC API函數 ==
Public Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
Public Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal Henv&, phdbcd&) As Integer
Public Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal Hdbc&, phstmt&) As Integer
Public Declare Function SQLConnect Lib "odbc32.dll" (ByVal Hdbc&, ByVal szDSN$, _
ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal szPWD$, ByVal cbPWD%) As Integer
Public Declare Function SQLColAttributes Lib "odbc32.dll" (ByVal Hstmt&, ByVal icol%, _
ByVal fDescType%, ByVal rgbDesc As String, ByVal cbDescMax%, pcbDesc%, pfDesc&) As Integer
Public Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal Hdbc&) As Integer
Public Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal Hstmt&, ByVal szSqlStr$, _
ByVal cbSqStr&) As Integer
Public Declare Function SQLFetch Lib "odbc32.dll" (ByVal Hstmt&) As Integer
Public Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal Hdbc&) As Integer
Public Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal Henv&) As Integer
Public Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal Hstmt&, ByVal fOption%) As Integer
Public Declare Function SQLGetData Lib "odbc32.dll" (ByVal Hstmt&, ByVal icol%, ByVal fCType%, _
ByVal rgbValue As String, ByVal cbValueMax&, pcbValue%) As Integer
Public Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal Hstmt&, pccol%) As Integer
Public Declare Function SQLGetDiagRec Lib "odbc32.dll" (ByVal HandleType%, ByVal Handle&, _
ByVal RecNumber%, Sqlstate%, NativeErrorPtr%, MessageText As String, _
ByVal Bufferlenchgth%, TextlenchgthPtr%)
'== 標記數據庫是否連接 ==
Private IsConnect As Boolean
'== 標記執行Connect()函數后，訪問數據庫的次數 ==
Private Connect_Num As Integer
Private Henv As Long     '環境句柄
Private Hdbc As Long     '連接句柄
Private Rc As Long
Public Hstmt As Long

'連接數據庫
Private Sub Connect()
  Dim TmpStat As Long  'SQLConnect()函數的返回值
  '如果連接標記為真，則返回。否則會出錯
  If IsConnect = True Then
    Exit Sub
  End If
  '分配環境句柄，保存在變量Henv中
  If SQLAllocEnv(Henv) Then
    MsgBox "無法初始化ODBC環境!", , "ODBC API執行錯誤"
    End
  End If
  '根據環境句柄，分配連接句柄，保存在變量Hdbc中
  If SQLAllocConnect(Henv, Hdbc) Then
    MsgBox "無法連接ODBC!", , "ODBC API執行錯誤"
    End
  End If
  '根據連接句柄、數據源、用戶名和密碼連接指定的數據庫
  TmpStat = SQLConnect(Hdbc, DSN, Len(DSN), DB_USER_NAME, _
            Lench(DB_USER_NAME), DB_PASSWORD, Len(DB_PASSWORD))
  '如果連接不成功則退出程序
  If TmpStat <> SQL_SUCCESS And _
     TmpStat <> SQL_SUCCESS_WITH_INFO Then
    MsgBox "無法獲得連接句柄!", , "ODBC API執行錯誤"
    IsConnect = True
    Disconnect
    End
  End If
  '設置連接標記
  IsConnect = True
End Sub

'斷開與數據庫的連接
Private Sub Disconnect()
  Dim Rc As Long
  '如果連接標記為假，標明已經斷開連接，則直接返回
  If IsConnect = False Then
    Exit Sub
  End If
  '斷開連接
  Rc = SQLDisconnect(Hdbc)
  '釋放連接句柄
  Rc = SQLFreeConnect(Hdbc)
  '釋放環境句柄
  Rc = SQLFreeEnv(Henv)
  IsConnect = False
End Sub

'使用Connect_Num控制數據庫連接
Public Sub DB_Connect()
  Connect_Num = Connect_Num + 1
  Connect
End Sub
Public Sub DB_Disconnect()
  If Connect_Num >= CONNECT_LOOP_MAX Then
    Connect_Num = 0
    Disconnect
  End If
End Sub
'強制關閉api方式訪問的數據庫，計數器復位
Public Sub DBapi_Disconnect()
  Connect_Num = 0
  Disconnect
End Sub

'執行ODBC數據庫操作語句
Public Sub OdbcExt(ByVal TmpSQLstmt As String)
  '根據連接句柄，分配語句句柄
  If SQLAllocStmt(Hdbc, Hstmt) Then
    MsgBox "句柄分配失敗", , "ODBC API執行錯誤"
    DBapi_Disconnect
    End
  End If
  '執行SQL語句，Lench是用戶自定義函數，計算包含漢字的字符串長度
  If SQLExecDirect(Hstmt, TmpSQLstmt, Lench(TmpSQLstmt)) Then
   MsgBox "數據庫訪問語句執行失敗", , "ODBC API執行錯誤"
    MsgBox TmpSQLstmt
   DBapi_Disconnect
    End
  End If
End Sub

'使用Data控件連接數據庫，將執行指定的SQL語句
Public Sub DBdataExt(TmpData As Data, ByVal TmpSource As String)
  '關閉已有的ODBC連接
  DBapi_Disconnect
  'Data控件連接數據庫
  TmpData.Connect = "ODBC;DATABASE=" + DATABASE _
                  + ";UID=" + DB_USER_NAME + ";PWD=" _
                  + DB_PASSWORD + ";DSN=" + DB_NAME
  TmpData.RecordSource = TmpSource
  TmpData.Refresh
End Sub