我們從Visual Studio 2010 開始已經放棄使用MS Access的資料庫, 改用了SQLite, 下面的函數庫, 必須安裝第三者的Connector 才能使用, 未完成的資料庫類別(MSSQL, PostgreSQL,MSAccess等)可如法炮製, 稍後會發放一些使用方法的例子 !
System.Data.SQLite
An open source ADO.NET provider for the SQLite database engine
http://sqlite.phxsoftware.com/MySQL Connector/Net 6.5.4
http://www.mysql.com/downloads/connector/net/Imports System.Data
Imports System.Data.OleDb
Imports System.Data.SQLite
Imports MySql.Data.MySqlClient
Module modDataFunct
Public gdbConnection As Object
Public gdbCommand As Object
Public grsData As Object
Public grsOpen As Object
Public grsFunction As Object
Public grsProcedure As Object
Public grsModule As Object
Public gintDatabaseSiteID As Integer
Public gintDatabaseType As Integer
Public gintDataErrorAction As Integer
Public gstrDatabaseName As String
Public gstrDataPath As String
Public gstrDataPort As String
Public gstrDataServerName As String
Public gstrDBPassword As String
Public gstrDBUserName As String
Public gstrLocalDBPassword As String
Public gblnTimeSync As Boolean
Public Const gcntAccess As Integer = 1
Public Const gcntMySQL As Integer = 2
Public Const gcntPostgreSQL As Integer = 3
Public Const gcntMSSQL As Integer = 4
Public Const gcntSQLite As Integer = 5
Public Sub CreateDBCommand(ByVal tmpDBConnection As Object, ByRef tmpDBCommand As Object)
Select Case gintDatabaseType
Case gcntAccess
tmpDBCommand = New OleDbCommand
Case gcntMySQL
tmpDBCommand = New MySqlCommand
Case gcntSQLite
tmpDBCommand = New SQLiteCommand
End Select
tmpDBCommand.Connection = tmpDBConnection
End Sub
Public Function CreateDBTransaction(ByVal tmpDBConnection As Object, ByRef tmpDBTransaction As Object) As Boolean
Dim tmpResult As Boolean = True
Try
Select Case gintDatabaseType
Case gcntAccess
tmpDBTransaction = tmpDBConnection.BeginTransaction(IsolationLevel.ReadCommitted)
Case gcntMySQL
tmpDBTransaction = tmpDBConnection.BeginTransaction(IsolationLevel.ReadCommitted)
Case gcntSQLite
tmpDBTransaction = tmpDBConnection.BeginTransaction(IsolationLevel.ReadCommitted)
End Select
Catch Ex As Exception
MessageBox.Show("CreateDBTransaction Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
tmpResult = False
End Try
Return tmpResult
End Function
Public Function CreateDBScalar(ByVal tmpSQL As String) As Object
Dim objResult As Object = String.Empty
Try
Select Case gintDatabaseType
Case gcntAccess
gdbCommand = New OleDbCommand(tmpSQL, gdbConnection)
objResult = gdbCommand.ExecuteScalar
Return objResult
Case gcntMySQL
gdbCommand = New MySqlCommand(tmpSQL, gdbConnection)
objResult = gdbCommand.ExecuteScalar
Return objResult
Case gcntSQLite
gdbCommand = gdbConnection.createcommand
gdbCommand.commandtext = tmpSQL
objResult = gdbCommand.ExecuteScalar
Return objResult
End Select
Catch ErrorHandle As Exception
Return -1
End Try
Return objResult
End Function
Public Function CreateDBReader(ByVal tmpSQL As String, ByRef tmpDBReader As Object) As Boolean
On Error GoTo ErrHandler
Select Case gintDatabaseType
Case gcntAccess
gdbCommand = New OleDbCommand(tmpSQL, gdbConnection)
tmpDBReader = gdbCommand.ExecuteReader
Case gcntMySQL
gdbCommand = New MySqlCommand(tmpSQL, gdbConnection)
tmpDBReader = gdbCommand.ExecuteReader
Case gcntSQLite
gdbCommand = gdbConnection.CreateCommand
gdbCommand.CommandText = tmpSQL
tmpDBReader = gdbCommand.ExecuteReader()
End Select
Return True
ErrHandler:
MessageBox.Show("CreateDBReader Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Function
Public Function CreateDBDataTable(ByVal tmpSQL As String, ByRef tmpDBDataTable As DataTable) As Boolean
On Error GoTo ErrHandler
Select Case gintDatabaseType
Case gcntAccess
'gdbCommand = New OleDbCommand(tmpSQL, gdbConnection)
'tmpDBReader = gdbCommand.ExecuteReader
Case gcntMySQL
gdbCommand = New MySqlCommand(tmpSQL, gdbConnection)
tmpDBDataTable.Clear()
tmpDBDataTable.Load(gdbCommand.ExecuteReader)
Case gcntSQLite
gdbCommand = gdbConnection.CreateCommand
gdbCommand.CommandText = tmpSQL
tmpDBDataTable.Clear()
tmpDBDataTable.Load(gdbCommand.ExecuteReader)
End Select
Return True
ErrHandler:
MessageBox.Show("CreateDBDataTable Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Function
Public Function OpenDataSource(ByVal tmpDatatype As Integer, Optional ByVal tmpErrorAction As Integer = 1) As Boolean
On Error GoTo ErrHandler
Dim tmpResult As Boolean
tmpResult = False
gintDataErrorAction = tmpErrorAction
Select Case tmpDatatype
Case gcntAccess
tmpResult = OpenAccessMDB()
Case gcntMySQL
tmpResult = OpenMySQL()
Case gcntMSSQL
'tmpResult = OpenMSDASQL
Case gcntPostgreSQL
'tmpResult = OpenPostGreSQL
Case gcntSQLite
tmpResult = OpenSQLite()
Case Else
tmpResult = False
End Select
Return tmpResult
ErrHandler:
MessageBox.Show("OpenDataSource Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Function
Public Function OpenMySQL() As Boolean
Dim tmpConnectionString As String
Dim tmpResult As Boolean
tmpResult = False
tmpConnectionString = "Server = " & gstrDataServerName & "; "
tmpConnectionString = tmpConnectionString & "port=" + gstrDataPort + ";"
tmpConnectionString = tmpConnectionString & "User id = " & gstrDBUserName & "; "
tmpConnectionString = tmpConnectionString & "Password = " & gstrDBPassword & "; "
tmpConnectionString = tmpConnectionString & "Database = " & gstrDatabaseName & "; "
tmpConnectionString = tmpConnectionString & "charset = utf8;"
tmpConnectionString = tmpConnectionString & "Pooling = false"
Try
gdbConnection = New MySqlConnection(tmpConnectionString)
gdbConnection.Open()
If gdbConnection.State = ConnectionState.Open Then
tmpResult = True
End If
Return tmpResult
Catch ErrorHandle As MySqlException
MessageBox.Show("OpenMySQL Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Try
End Function
Public Function OpenSQLite() As Boolean
On Error GoTo ErrHandler
Dim tmpConnectionString As String
Dim tmpResult As Boolean
tmpResult = False
gdbConnection = New SQLiteConnection
tmpConnectionString = "Data Source=" + gstrDataPath + gstrDatabaseName + ";"
tmpConnectionString = tmpConnectionString + "Version=3;"
tmpConnectionString = tmpConnectionString + "Password=XXXXXX;" '開啟有加密的資料庫, 預設使用 .net RC4 算法, 可使用Sqlite Expert
gdbConnection.ConnectionString = tmpConnectionString
Call gdbConnection.Open()
If gdbConnection.State = ConnectionState.Open Then
'gdbConnection.changepassword("XXXXXX") 設定密碼
'gdbConnection.changepassword(String.Empty) 清除密碼
tmpResult = True
End If
Return tmpResult
ErrHandler:
MessageBox.Show("OpenSQLite Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Function
Public Function OpenAccessMDB() As Boolean
On Error GoTo ErrHandler
Dim tmpConnectionString As String
Dim tmpResult As Boolean
tmpResult = False
gdbConnection = New OleDbConnection 'connect to ODBC database
tmpConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;"
tmpConnectionString = tmpConnectionString + "Data Source=" + gstrDataPath + gstrDatabaseName + ";"
tmpConnectionString = tmpConnectionString + "Jet OLEDB:Database Password=" + gstrDBPassword + ";"
'tmpConnectionString = tmpConnectionString + "Jet OLEDB:Transaction Commit Mode= 1;" '立即更新儲存, 不要寫入的Buffer
gdbConnection.ConnectionString = tmpConnectionString
Call gdbConnection.Open()
If gdbConnection.State = ConnectionState.Open Then
tmpResult = True
End If
Return tmpResult
ErrHandler:
MessageBox.Show("OpenAccessMDB Module Error : " & Err.Number & " - " & Err.Description, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return False
End Function
Public Sub FillAryVariant(ByVal tmpSQL As String, ByRef tmpArray(,) As String)
On Error GoTo ErrHandler
Dim intX As Integer
Dim intY As Integer
If CreateDBReader(tmpSQL, grsModule) = True Then
intY = -1
ReDim tmpArray(grsModule.FieldCount - 1, intY)
Do Until Not grsModule.Read
intY = intY + 1
ReDim Preserve tmpArray(grsModule.FieldCount - 1, intY)
For intX = 0 To grsModule.FieldCount - 1
tmpArray(intX, intY) = grsModule.Item(intX).ToString
Next intX
Loop
grsModule.Close()
Else
tmpArray = Nothing
End If
Exit Sub
ErrHandler:
If grsModule.IsClosed = False Then
grsModule.Close()
End If
If gblnEnableDebugMode = True Then
MsgBox("FillAryVariant Module Error : ")
End If
End Sub
End Module
