Attribute VB_Name = "modDataFunct"
'**** Reference Microsoft ActiveX Data Objects 2.8 Library ****
Option Explicit
Public Conn As New Connection
Public rsTemp As New ADODB.Recordset
Public rsModule As New ADODB.Recordset
Public rsData As New ADODB.Recordset
Public gstrDBPassword As String
Public gstrLocalDBPassword As String
Public gstrDBUserName As String
Public gintMySQLConfig As Integer
Public gintDataErrorAction As Integer
'Checks if the ado data connection is still live Auto-reconnects if lAutoReconnect = true
Private Function ADOReConnect(ByRef dbConnection As ADODB.Connection) As Boolean
On Error GoTo ErrHandler
Dim tmpResult As Boolean
tmpResult = False
If Len(dbConnection.ConnectionString) > 0 Then
dbConnection.Open
If dbConnection.State = adStateOpen Then tmpResult = True
End If
ADOReConnect = True
Exit Function
ErrHandler:
ADOReConnect = False
End Function
Public Function ADOConnectionState(ByRef dbConnection As ADODB.Connection, Optional ByVal lAutoReconnect As Boolean = True) As Boolean
On Error GoTo ErrHandler
Dim tmpResult As Boolean
tmpResult = True
dbConnection.Execute "select 1"
ADOConnectionState = tmpResult
Exit Function
ErrHandler:
tmpResult = False
If lAutoReconnect = True Then
If ADOReConnect(dbConnection) = True Then
tmpResult = True
End If
End If
ADOConnectionState = tmpResult
End Function
Public Sub CloseDatabase()
If Conn.State = 1 Then Conn.Close
Set rsData = Nothing
Set rsOpen = Nothing
Set rsModule = Nothing
Set rsTemp = Nothing
Set Conn = Nothing
End Sub
Public Function OpenDataSource(tmpDatatype As Integer, Optional tmpErrorAction As Integer = 1) As Boolean
On Error GoTo ErrHandler
Dim tmpResult As Boolean
gintDataErrorAction = tmpErrorAction
tmpResult = False
Select Case tmpDatatype
Case 1
tmpResult = OpenAccess
Case 2
tmpResult = OpenMySQL
Case 3
tmpResult = OpenMSDASQL
Case 4
tmpResult = OpenPostGreSQL
Case Else
tmpResult = False
End Select
OpenDataSource = tmpResult
Exit Function
ErrHandler:
OpenDataSource = False
MsgBox "OpenDataSource Module Error : " & Err.Number & "#" & Err.Description, vbCritical,"Error"
End Function
Private Function OpenMSDASQL() As Boolean
On Error GoTo ErrOpenLocal
With Conn
.Provider = "MSDASQL.1;Driver={Microsoft Access Driver (*.mdb)};DBQ=" & gstrDataPath & gstrDatabaseName & ";PWD=" & gstrDBPassword & ";"
.Open
End With
OpenMSDASQL = True
Exit Function
ErrOpenLocal:
OpenMSDASQL = False
MsgBox "Access Database Open Error !", vbCritical, "Error"
End Function
Private Function OpenAccess() As Boolean
On Error GoTo ErrOpenLocal
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:Database Password") = gstrDBPassword
.ConnectionString = "Data Source=" & gstrDataPath & gstrDatabaseName
.Open
.Properties("Jet OLEDB:Transaction Commit Mode") = 1 '立即更新儲存, 不要寫入的Buffer
End With
OpenAccess = True
Exit Function
ErrOpenLocal:
OpenAccess = False
MsgBox "Access Database Open Error !", vbCritical, "Error"
End Function
Private Function OpenMySQL() As Boolean
On Error GoTo ErrOpenMySQL
Dim tmpServer As String
Dim tmpPort As String
With Conn
tmpServer = "server=" + gstrServerName + ";"
tmpPort = "port=" + gstrDataPort + ";"
.ConnectionString = tmpServer + tmpPort + "db=" & gstrDatabaseName & ";driver=" & gstrODBCDriver & ";uid=" & gstrDBUserName & ";pwd=" & gstrDBPassword & ";charset=utf8"
.Open
End With
If gintMySQLConfig = 1 Then
Conn.Execute ("SET character_set_client = utf8")
Conn.Execute ("SET character_set_results =big5")
Conn.Execute ("SET character_set_connection = big5")
Conn.Execute ("SET collation_connection = @@collation_database")
End If
OpenMySQL = True
Exit Function
ErrOpenMySQL:
OpenMySQL = False
MsgBox "OpenMySQL Module Error : " & Err.Number & "#" & Err.Description, vbCritical, "Error"
End Function
' MySQL 5.1 的設定參數, 伺服器的預設字符集為 utf8
' Conn.Execute ("SET character_set_client = utf8")
' Conn.Execute ("SET character_set_results =big5")
' Conn.Execute ("SET character_set_connection = big5")
' Conn.Execute ("SET collation_connection = @@collation_database")
Private Function OpenPostGreSQL() As Boolean
On Error GoTo ErrHandler
Dim tmpServer As String
Dim tmpPort As String
With Conn
tmpServer = "server=" + gstrServerName + ";"
tmpPort = "port=" + gstrDataPort + ";"
.ConnectionString = tmpServer + tmpPort + "database=" & gstrDatabaseName & ";driver=" & gstrODBCDriver & ";uid=" & gstrDBUserName & ";pwd=" & gstrDBPassword
.Open
End With
OpenPostGreSQL = True
Exit Function
ErrHandler:
OpenPostGreSQL = False
MsgBox "PostGreSQL Database Open Error !", vbCritical, "Error"
End Function
