所谓的连贯操作,类似于 mysql.table("table").where("1").find()。我不太喜欢为了写个查询,写多行语句。所以封装了一下。
框架为.net framework4,mysql.data.dll也是基于此框架。最低可用在XP系统上。最高目前为win10可用。
封装代码:
Imports MySql.Data.MySqlClient
Imports System.Text.RegularExpressions
Public Class Mysql
Private _where As String
Private _table As String
Private _field As String
Private _join As String
Private _limit As String
Private _group As String
Private _order As String
Private _sql As String
Public _db_prefix As String
Public Db_host As String
Public Db_user As String
Public Db_pwd As String
Public Db_db As String
Private field_struct As IDictionary
Dim info As Information
Dim con As New MySqlConnection()
Dim adapter As MySqlDataAdapter
Dim sqlCmd As MySqlCommand
Public Sub New(Optional ByVal host As String = "", Optional ByVal user As String = "", Optional ByVal pwd As String = "", Optional ByVal database As String = "", Optional ByVal db_prefix As String = "")
_field = "*"
Me.Db_host = host
Me.Db_user = user
Me.Db_pwd = pwd
Me.Db_db = database
Me._db_prefix = db_prefix
End Sub
Public Sub close()
Debug.Print("con.state=" & con.State)
If con.State = ConnectionState.Open Then
con.Close()
End If
End Sub
Private Function Connect() As Information
Dim pingResult As Boolean = False
Try
pingResult = con.Ping()
Catch ex As Exception
pingResult = False
End Try
If (pingResult = True) Then
'Debug.Print("不需要连接数据库")
Return New Information(1, "ok")
End If
Try
Debug.Print("连接数据库")
Dim M_str_sqlcon As String = "server=" & Db_host & ";user id=" & Db_user & ";password=" & Db_pwd & ";database=" & Db_db & ";Allow Zero Datetime=True;Connect Timeout=30;"
con = New MySqlConnection(M_str_sqlcon)
con.Open()
Return New Information(1, "ok")
Catch ex As MySqlException
Debug.Print("连接数据库失败。" & ex.Message)
Return New Information(-1, ex.Message)
End Try
End Function
Public Function BuildSql()
If (_table = "") Then
info.code = -1
info.message = "没有指定表名"
Else
Dim sql As String = "SELECT " & _field & " FROM " & _table & IIf(_join <> "", _join, "") & IIf(_where <> "", " WHERE" & _where, "") & IIf(_group <> "", " GROUP BY" & _group, "") & IIf(_order <> "", " ORDER BY" & _order, "") & IIf(_limit <> "", _limit, "")
info.code = 1
info.ret_str = sql
End If
Return info
End Function
Public Function Find()
If (_table = "") Then
info.code = -1
info.message = "没有指定表名"
Return info
End If
Me.Limit(0, 1)
Dim build_result As Information
build_result = buildSql()
If (build_result.code < 0) Then
info.code = -2
info.message = build_result.message
Return info
Else
Dim sql As String = build_result.ret_str
Dim result As Information
Me._sql = sql
result = _query(sql)
Return result
End If
End Function
Public Function Find(sql As String)
Me._sql = sql
Dim result As Information = _query(sql)
Return result
End Function
Public Function Query()
If (_table = "") Then
info.code = -2
info.message = "没有指定表名"
Return info
Else
Dim build_result As Information
build_result = buildSql()
If (build_result.code < 0) Then
info.code = -2
info.message = build_result.message
Return info
Else
Dim result As Information
Dim sql As String = build_result.ret_str
Me._sql = sql
result = _query(sql)
Return result
End If
End If
End Function
Public Function Query(sql As String)
Dim result As New Information
result = _query(sql)
Return result
End Function
Public Function SetInc(field As String, Optional ByVal number As Double = 1)
Return Me.IncDec(field, 1, number)
End Function
Public Function SetDec(field As String, Optional ByVal number As Double = 1)
Return Me.IncDec(field, "-1", number)
End Function
Private Function IncDec(field As String, ByVal action As Int16, Optional ByVal number As Double = 1)
If (_table = "") Then
info.code = -3
info.message = "没有指定表名"
Return info
End If
If (Me._where = "") Then
info.code = -4
info.message = "SetInc方法要求必须指定where条件"
Return info
End If
Dim Sql As String
Sql = "UPDATE " & _table & " SET " & field & "=" & field & IIf(action = "1", "+", "-") & number & IIf(_where <> "", " WHERE" & _where, "")
Dim Result As New Information
Me._sql = Sql
Result = Me._query(Sql)
Return Result
End Function
Public Function Count(Optional field As String = "*")
If (_table = "") Then
info.code = -5
info.message = "没有指定表名"
Return info
End If
If (Me._where = "") Then
info.code = -6
info.message = "SetInc方法要求必须指定where条件"
Return info
End If
Dim sql As String, result As New Information
If field <> "*" Then
sql = "SELECT COUNT(" & field & ") as " & field
Else
sql = "SELECT COUNT(" & field & ")"
End If
sql &= " FROM " & _table & IIf(_join <> "", _join, "") & " WHERE" & IIf(_where <> "", _where, " 1") & IIf(_group <> "", " GROUP BY" & _group, "")
Me._sql = sql
result = _query(sql)
Return result
End Function
Private Function _sum(Sql_str As String)
Dim sql As String
If _field <> "" And _field <> "*" Then
Sql_str &= "," & _field
End If
sql = "SELECT " & Sql_str & " FROM " & _table & IIf(_join <> "", _join, "") & " WHERE" & IIf(_where <> "", _where, " 1") & IIf(_group <> "", " GROUP BY" & _group, "")
Me._sql = sql
Dim result As Information = Me._query(Sql)
Return result
End Function
Public Function Sum(param As String)
Dim Sql_str As String
Sql_str = "sum(" & param & ") as " & param
Return Me._sum(Sql_str)
End Function
Public Function Sum(param(,) As String)
Dim Sql_str As String = "", sql As String = ""
If (_table = "") Then
info.code = -7
info.message = "没有指定表名"
Return info
End If
For i = 0 To UBound(param)
Sql_str &= "sum(" & param(i, 0) & ") as " & param(i, 1) & ","
Next
Sql_str = Left(Sql_str, Len(Sql_str) - 1)
Return Me._sum(Sql_str)
End Function
Public Function Execute(sql As String)
Me._sql = sql
Dim result As Information = Me._query(sql)
Return result
End Function
'返回最后插入的记录的自增id
Public Function Add(data(,) As String, Optional Replace As Boolean = False)
If (_table = "") Then
info.code = -8
info.message = "没有指定表名"
Return info
End If
If data.Length = 0 Then
info.code = -9
info.message = "要写入的数据是空的"
Return info
End If
Dim sql_str As String, result As New Information, getFieldResult As Boolean, exeCmd As String
If field_struct Is Nothing Then
getFieldResult = Me.GetFields(_table)
ElseIf field_struct.Count = 0 Then
getFieldResult = Me.GetFields(_table)
Else
getFieldResult = True
End If
If getFieldResult = False Then
result.code = -10
result.message = "无法获取表的结构"
Return result
End If
If Replace = True Then
exeCmd = "REPLACE INTO "
Else
exeCmd = "INSERT INTO "
End If
sql_str = exeCmd & _table & " SET " & Me.implode(data, ",")
Me._sql = sql_str
result = Me._query(sql_str)
Return result
End Function
'返回受影响的行数
Public Function Save(data(,) As String)
If (_table = "") Then
info.code = -11
info.message = "没有指定表名"
Return info
End If
If (Me._where = "") Then
info.code = -12
info.message = "save方法要求必须指定where条件"
Return info
End If
If data.Length = 0 Then
info.code = -13
info.message = "要保存的数据是空的"
Return info
End If
Dim sql_str As String, result As New Information, getFieldResult As Boolean
getFieldResult = Me.GetFields(_table)
If getFieldResult = False Then
result.code = -14
result.message = "无法获取表的结构"
Return result
End If
sql_str = "UPDATE " & _table & " SET " & Me.implode(data, ",") & " WHERE" & _where
Me._sql = sql_str
result = Me._query(sql_str)
Return result
End Function
'返回受影响的行数
Public Function delete()
If (_table = "") Then
info.code = -15
info.message = "没有指定表名"
Return info
End If
If (Me._where = "") Then
info.code = -16
info.message = "delete方法要求必须指定where条件"
Return info
End If
Dim sql As String
sql = "DELETE FROM " & _table & " WHERE" & _where
Me._sql = sql
Return _query(sql)
End Function
Public Function AddAll(data(,,) As String, Optional replace As Boolean = False)
Dim keys As String = "", value As String, result As New Information, values_last As String = "", sql As String, getFieldResult As Boolean
Dim i As Int16, j As Int16
If field_struct Is Nothing Then
getFieldResult = Me.GetFields(_table)
ElseIf field_struct.Count = 0 Then
getFieldResult = Me.GetFields(_table)
Else
getFieldResult = True
End If
If getFieldResult = False Then
result.code = -17
result.message = "无法获取表的结构"
Return result
End If
For i = 0 To UBound(data, 2)
If (data(0, i, 0) IsNot Nothing) Then
If (field_struct.Contains(data(0, i, 0)) = True) Then
keys &= "`" & data(0, i, 0) & "`" & ","
End If
End If
Next
If (keys <> "") Then
keys = "(" & Left(keys, Len(keys) - 1) & ")"
Else
result.code = -18
result.message = "获取表结构时没有获取字段信息" & keys
Return result
End If
For i = 0 To UBound(data)
value = ""
For j = 0 To UBound(data, 2)
If (data(i, j, 0) IsNot Nothing) Then
If (field_struct.Contains(data(i, j, 0)) = True) Then
value &= Me.quote(data(i, j, 1), Me.field_struct.Item(data(i, j, 0)).item("Type")) & ","
End If
End If
Next
If value <> "" Then
values_last &= "(" & Left(value, Len(value) - 1) & "),"
End If
Next
values_last = Left(values_last, Len(values_last) - 1)
If (values_last <> "") Then
sql = IIf(replace, "REPLACE INTO ", "INSERT INTO ") & _table & keys & " VALUES " & values_last
Me._sql = sql
result = _query(sql)
Return result
Else
info.code = -11
info.message = "无法构建多个values数据,结果为空。"
Return info
End If
End Function
Public Function Field(field_value As String)
Me._field = field_value
Return Me
End Function
Public Function GetLastSql()
Return _sql
End Function
Public Function Table(table_value As String, Optional alias_value As String = "")
_table = _db_prefix & table_value
If (alias_value <> "") Then
_table &= " as " & alias_value
End If
Return Me
End Function
Public Function Limit(start_value As Int32, Optional limit_value As Int32 = 0)
Dim limit_final As String = CInt(IIf(limit_value > 0, limit_value, 0))
Dim start_final As String = CInt(IIf(start_value > 0, start_value, 0))
If (start_final > 0 And limit_final > 0) Then
_limit = " LIMIT" & start_final & ", " & limit_final
ElseIf (limit_final > 0) Then
_limit = " LIMIT " & limit_final
ElseIf (start_final > 0) Then
_limit = " LIMIT " & start_final
Else
_limit = ""
End If
Return Me
End Function
Public Function Order(Optional oder_str As String = "")
If (oder_str <> "") Then
Me._order = " " & oder_str
End If
Return Me
End Function
Public Function Group(Optional group_str As String = "")
If (group_str <> "") Then
Me._group = " " & group_str
End If
Return Me
End Function
Public Function Join(Optional join_str As String = "")
If (join_str = "") Then
Me._join = ""
Return Me
End If
Dim rgx As Regex = New Regex("__(.*?)__")
join_str = rgx.Replace(join_str, _db_prefix & "$1")
Me._join &= " " & join_str
Return Me
End Function
Public Function Where(ParamArray Items())
If (Items.Length = 1) Then
Me._where = " " & (Items(0))
ElseIf (Items.Length = 0) Then
Me._where = ""
Else
Dim result As String
result = Me._sprintf(Items)
Me._where = " " & result
End If
Return Me
End Function
Public Function _sprintf(ParamArray Items()) As String
Dim num As Int16 = Items.Length
Dim oStr = Items(0)
Dim rgx As Regex = New Regex("%\w?")
For i = 1 To num - 1
oStr = rgx.Replace(oStr, Me.quote(Items(i).ToString(), "text", False), 1)
Next
Return oStr
End Function
Public Sub StartTrans()
Dim ret_code As Long
Call Connect()
sqlCmd = New MySqlCommand("SET AUTOCOMMIT=0;start transaction;", con)
ret_code = sqlCmd.ExecuteNonQuery()
End Sub
Public Sub Rollback()
Dim ret_code As Long
Call Connect()
sqlCmd = New MySqlCommand("SET AUTOCOMMIT=1;", con)
sqlCmd.ExecuteNonQuery()
sqlCmd = New MySqlCommand("rollback;", con)
ret_code = sqlCmd.ExecuteNonQuery()
End Sub
Public Sub Commit()
Dim ret_code As Long
Call Connect()
sqlCmd = New MySqlCommand("SET AUTOCOMMIT=1;", con)
sqlCmd.ExecuteNonQuery()
sqlCmd = New MySqlCommand("commit;", con)
ret_code = sqlCmd.ExecuteNonQuery()
End Sub
Private Function implode(arr(,) As String, Optional glue As String = ",")
Dim glue_final As String, sql_str As String = "", cmd As String = ""
glue_final = " " & glue & " "
Dim i As Int16
For i = 0 To UBound(arr)
If arr(i, 0) IsNot Nothing Then
If field_struct.Contains(arr(i, 0)) = True Then
sql_str &= cmd & "`" & arr(i, 0) & "`" & "=" & Me.quote(arr(i, 1), Me.field_struct.Item(arr(i, 0)).item("Type"))
End If
cmd = glue_final
End If
Next
Return sql_str
End Function
Private Function quote(str As String, type As String, Optional withquote As Boolean = True)
If Mid(type, 1, 3) = "int" Or Mid(type, 1, 6) = "bigint" Or Mid(type, 1, 9) = "mediumint" Or Mid(type, 1, 7) = "tinyint" Or Mid(type, 1, 8) = "smallint" Or Mid(type, 1, 7) = "decimal" Or Mid(type, 1, 5) = "float" Or Mid(type, 1, 6) = "double" Then
If str = "" Or str = Nothing Then
Return 0
End If
Return str
End If
If type = "tinytext" Or Mid(type, 1, 7) = "varchar" Or Mid(type, 1, 4) = "char" Or type = "text" Or Mid(type, 1, 10) = "mediumtext" Or Mid(type, 1, 8) = "longtext" Or Mid(type, 1, 4) = "enum" Then
Return IIf(withquote = True, "'", "") & Replace(Replace(str, "\", "\\"), "'", "\'") & IIf(withquote = True, "'", "")
End If
Return IIf(withquote = True, "'", "") & Replace(Replace(str, "\", "\\"), "'", "\'") & IIf(withquote = True, "'", "")
End Function
Private Function _query(sql As String) As Information
'Debug.Print(sql)
Dim iDataTable = New DataTable, cmd As String
Call Connect()
cmd = UCase(Mid(sql, 1, InStr(sql, " ") - 1)).Trim
Try
If (cmd = "UPDATE" Or cmd = "DELETE" Or cmd = "REPLACE" Or cmd = "INSERT") Then
Dim ret_code As Long
sqlCmd = New MySqlCommand(sql, con)
ret_code = sqlCmd.ExecuteNonQuery()
If cmd = "INSERT" Then
ret_code = sqlCmd.LastInsertedId
ElseIf cmd = "REPLACE" Then
'不需要处理,直接调用上面的ret_code
If sqlCmd.LastInsertedId > 0 Then
ret_code = sqlCmd.LastInsertedId
End If
End If
If ret_code > 0 Then
info.code = ret_code
info.ret_str = ret_code
Else
info.code = -101
info.message = "操作失败。ret_code=" & ret_code & "。your sql is " & sql
End If
ElseIf cmd = "SELECT" Then
adapter = New MySqlDataAdapter(sql, con)
Dim iMySqlCommandBuilder = New MySqlCommandBuilder(adapter)
adapter.Fill(iDataTable)
'con.Close()
info.code = 1
info.data = iDataTable
End If
_where = ""
_table = ""
_join = ""
_field = "*"
_limit = ""
_group = ""
_order = ""
field_struct = Nothing
Return info
Catch ex As Exception
_where = ""
_table = ""
_join = ""
_field = "*"
_limit = ""
_group = ""
_order = ""
field_struct = Nothing
info.code = -1000
info.message = ex.Message & "。your sql is " & sql
'con.Close()
Return info
End Try
End Function
Public Function GetFields(table_name As String)
'Debug.Print("获取表的字段" & table_name)
Dim sql As String, iDataTable = New DataTable
If table_name.Trim() = "" Then
Return False
End If
sql = "SHOW COLUMNS FROM `" & table_name & "`"
Try
Call Connect()
adapter = New MySqlDataAdapter(sql, con)
Dim iMySqlCommandBuilder = New MySqlCommandBuilder(adapter)
adapter.Fill(iDataTable)
Dim dict As New Dictionary(Of String, IDictionary)
For Each dr As DataRow In iDataTable.Rows
Dim dc As New Dictionary(Of String, String)
dc.Add("Field", dr.Item("field"))
dc.Add("Type", dr.Item("Type"))
dc.Add("Null", dr.Item("Null"))
dc.Add("Key", dr.Item("Key"))
dict.Add(dr.Item("Field"), dc)
Next
field_struct = dict
Return True
Catch ex As Exception
Return False
End Try
End Function
End Class
调用方法:
Dim str As String = (("308027"))
Debug.Print(Mid(str, str.Length - 3))
'Dim data(,) As String = New String(3, 1) {{"fullname", "李一二"}, {"password", "222"}, {"age", 222}, {"regdate", 123}}
'Dim data(,,) As String = New String(2, 3, 1) {{{"fullname", "张三"}, {"password", "1111"}, {"age", 10}, {"regdate", 123}}, {{"fullname", "李四"}, {"password", "2222"}, {"age", 20}, {"regdate", 456}}, {{"fullname", "王五"}, {"password", "3333"}, {"age", 30}, {"regdate", 789}}}
Dim d As New Information
'd = Module1.mySql.Table("user").where("uid > 2").group("fullname").count()
'Debug.Print(Module1.mySql.GetLastSql())
'Debug.Print(d.data.Rows(0).Item(0))
'd = Module1.mySql.Table("user").where("uid=0").delete()
'Debug.Print(Module1.mySql.GetLastSql())
'd = Module1.mySql.Table("user").where("uid=13").AddAll(data, True)
'Web.get_setting()
'=======================================================================================================
'------------------------记录数
'd = Module1.mySql.Table("user").where("uid > 2").count()
'Debug.Print(d.data.Rows(0).Item(0))
'------------------------多列合计
'Dim param(,) As String = {{"regdate", "reg"}, {"uid", "id"}}
'd = Module1.mySql.Table("user").field("uid,fullname").where("uid>8").Sum(param)
'If (d.code > 0) Then
' Debug.Print(d.data.Rows(0).Item("id"))
'Else
' Debug.Print(d.message)
'End If
'------------------------单列合计
'Dim para As String = "regdate"
'd = Module1.mySql.Table("user").field("uid,fullname").where("uid>8").Sum(para)
'If (d.code > 0) Then
' Debug.Print(d.data.Rows(0).Item("regdate"))
'Else
' Debug.Print(d.message)
'End If
'd = Module1.mySql.Find("select fullname from c_user where uid=1")
'Debug.Print(d.data.Rows(0).Item(0))
'------------------------事务
'Module1.mySql.StartTrans()
'Module1.mySql.Table("user").where("uid=9").delete()
'Module1.mySql.Commit()
'------------------------替换插入
'd = Module1.mySql.Table("user").Where("uid>=%d", 6).add(data, True)
'------------------------修改
'd = Module1.mySql.Table("user").Where("uid>=%d", 6).save(data)
'------------------------单条查询
'd = Module1.mySql.Table("user").Where("uid=%d", 2).Find()
'------------------------直接写sql语句
'd = Module1.mySql.Find("select * from c_user where uid=1")
'd = Module1.mySql.Query("select * from c_user where uid=1")
'------------------------多条查询
'd = Module1.mySql.Table("user").Where("uid>=%d", 1).query()
'------------------------execute
'd = Module1.mySql.Execute("update c_user set fullname='大老张' where uid>1")
'------------------------删除
'd = Module1.mySql.Table("user").where("uid=13").delete()
'------------------------插入多条记录
'd = Module1.mySql.Table("user").where("uid=13").AddAll(data, True)
'Debug.Print("d.code=" & d.code)
'If d.code <= 0 Then
' Debug.Print("code=" & d.code & ",msg=" & d.message)
'Else
' Debug.Print("code>0")
'End If
'Debug.Print(d.data.Rows(0).Item("fullname"))
里面用到了information,定义如下:
Public Structure Information
Dim code As Int64
Dim message As String
Dim ret_str As String
Dim data As DataTable
Dim count As Long
Public Sub New(ByRef codeV As Int64, ByRef msg As String, Optional data_table As DataTable = Nothing)
code = codeV
message = msg
data = data_table
End Sub
End Structure
module1 mysql 的定义:
public mySql
mySql = New Mysql(db_host, db_user, db_pwd, db_name, db_prefix)
'参数分别为:主机地址,数据库用户名,数据库密码,数据库名,数据库表前缀
想测试哪个功能就把哪个的注释符号删除。测试的时候注意数据安全性。不要误删、误修改数据
遇见有问题的地方,记得回复通知我。因为我测试也不是很完整。谢谢
这里不能上传xp可用的mysql.data.dll,大家可以自行安装mysql连接器,下载xp可用的版本。我这个版本是6.3.7.0。觉得麻烦可以下载我上传的资源: