我的数据访问类

Public Class BqDataClass '数据访问类

Dim ldailDataName As String

Dim ldailYN As Boolean = False

Dim ldailConnectionString As String

Dim ldailConn As New Data.OleDb.OleDbConnection

Dim lcmd As OleDb.OleDbCommand

Dim lNoODBC As String = "3"

Dim lDataName As String

Dim lPassWord As String

Dim lSqlDBname As String

Dim lSqlServerHost As String

Dim lDatabase As String

Dim lDataSource As String

Dim lProvider As String

Dim lServerVersion As String

Dim lConnectionString As String

Dim lSchemaTable As DataTable

Dim lDaSet As New System.Data.DataSet

Dim lAdapter As New System.Data.OleDb.OleDbDataAdapter

Public Sub New()

MyBase.New()

lDaSet.Clear()

lDaSet.Tables.Clear()

End Sub

Public WriteOnly Property BqDataType() As String '数据源类型

Set(ByVal Value As String)

lNoODBC = Value

End Set

End Property

Public WriteOnly Property BqDataName() As String

'如果是access数据库，则需要提供路径，

'如果是sql数据库，则只需要数据库名

Set(ByVal Value As String)

lDataName = Trim(LCase(Value))

End Set

End Property

Public WriteOnly Property BqDataPassWord() As String

Set(ByVal Value As String)

lPassWord = Value

End Set

End Property

Public WriteOnly Property BqDataServerName() As String

'access数据库不用

Set(ByVal Value As String)

End Set

End Property

Public WriteOnly Property BqDailDataName() As String

Set(ByVal Value As String)

ldailYN = False

ldailConnectionString = ""

Dim n2 As String

n2 = " Provider=Microsoft.Jet.OLEDB.4.0 ; "

n2 += " Data Source= " & Value

n2 += " ;Persist Security Info=False;Jet OLEDB:Database Password=bqss "

Try

ldailConn.ConnectionString = n2

ldailConn.Open()

ldailConn.Close()

ldailConnectionString = n2

ldailDataName = Value

ldailYN = True

Catch ex As Exception

End Try

End Set

End Property

Public Function BqDataOpen() As Boolean

'直接从注册表中读取数据库名。如果需要打开别的数据库，就先调用MMgFindDB

Dim m0 As Boolean = False '返回值

Dim s1, s2, s3, s4, s5 As String

Dim n1 As String

lDatabase = ""

lDataSource = ""

lProvider = ""

lServerVersion = ""

lConnectionString = ""

Select Case lNoODBC

Case "1" 'SQL-Server

'SQL数据库名称和主机名

s1 = lDataName

s2 = lSqlServerHost

If s1 = Nothing Or s2 = Nothing Then

Else

n1 = "Integrated Security=SSPI;Packet Size=4096;"

n1 = n1 & "Tag with column collation when possible=False;"

n1 = n1 & "Initial Catalog=" & s1 & ";"

n1 = n1 & "Use Procedure for Prepare=1;Auto Translate=True;"

n1 = n1 & "Persist Security Info=False;Provider=" & Chr(34) & "SQLOLEDB.1" & Chr(34) & ";"

n1 = n1 & "Workstation ID=" & Chr(34) & s2

n1 = n1 & Chr(34) & ";Use Encryption for Data=False"

End If

Case "2"

Case "3" ' MDB OLEdB3

s1 = lDataName

s2 = lPassWord

n1 = "Provider=Microsoft.Jet.OLEDB.3.51;"

n1 += "Persist Security Info=False;Data Source= " & s1

n1 += " ;Jet OLEDB:Database Password=" & s2

Case "4" ' MDB OLEdB4

s1 = lDataName

s2 = lPassWord

n1 = "" '按以下设置，密码错了，也打不开数据库

n1 += " Jet OLEDB:Global Partial Bulk Ops=2; "

n1 += " Jet OLEDB:Registry Path=; "

n1 += " Jet OLEDB:Database Locking Mode=1; "

n1 += " Jet OLEDB:Database Password=bqss;Data Source= " & s1

n1 += " ;Password=; "

n1 += " Jet OLEDB:Engine Type=5; "

n1 += " Jet OLEDB:Global Bulk Transactions=1; "

n1 += " Provider= Microsoft.Jet.OLEDB.4.0; "

n1 += " Jet OLEDB:System database=; "

n1 += " Jet OLEDB:SFP=False;Extended Properties=;Mode=Share Deny None; "

n1 += " Jet OLEDB:New Database Password=; "

n1 += " Jet OLEDB:Create System Database=False; "

n1 += " Jet OLEDB:Don't Copy Locale on Compact=False; "

n1 += " Jet OLEDB:Compact Without Replica Repair=False;User ID=Admin; "

n1 += " Jet OLEDB:Encrypt Database=False "

Case "5"

Case Else

n1 = ""

End Select

Dim lConn As New Data.OleDb.OleDbConnection

Try '先关闭连接

lConnectionString = n1

With lConn

.ConnectionString = n1

.Open()

lDatabase = .Database

lDataSource = .DataSource

lProvider = .Provider

lServerVersion = .ServerVersion

'返回数据库中的表或视图(查询)

lSchemaTable = .GetOleDbSchemaTable(OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, Nothing})

End With

m0 = True

Catch ex As Exception '在此处添加错误处理。

MMsg("连接数据库失败！" & ex.Message, 0, 0)

m0 = False

Finally

lConn.Close()

lConn.Dispose()

End Try

Return m0

End Function

Public Sub BqDataClear()

lDaSet.Clear()

lDaSet.Tables.Clear()

End Sub

Public ReadOnly Property sDatabase() As String

Get

Return lDatabase

End Get

End Property

Public ReadOnly Property sDataSource() As String

Get

Return lDataSource

End Get

End Property

Public ReadOnly Property sProvider() As String

Get

Return lProvider

End Get

End Property

Public ReadOnly Property sServerVersion() As String

Get

Return lServerVersion

End Get

End Property

Public ReadOnly Property sConnectionString() As String

Get

Return lConnectionString

End Get

End Property

Public ReadOnly Property sSchemaTable() As DataTable

Get

Return lSchemaTable

End Get

End Property

Public ReadOnly Property BqGetDataSet() As DataSet

Get

Return lDaSet.Copy

End Get

End Property

Public Function BqPrintTable(ByVal ltb As DataTable)

If IsNothing(ltb) = True Then Exit Function

Dim r As DataRow

Dim c As DataColumn

Dim s As String = ""

s = ""

For Each c In ltb.Columns

s += vbTab & c.ColumnName

Debug.WriteLine("=============================")

Debug.WriteLine("表：" & ltb.TableName & " 记录数：" & ltb.Rows.Count)

Debug.WriteLine("")

Debug.WriteLine(s)

Debug.WriteLine("")

For Each r In ltb.Rows

s = ""

For Each c In ltb.Columns

s += vbTab & r(c.ColumnName).ToString

Debug.WriteLine(s)

Debug.WriteLine("=============================")

Debug.WriteLine("")

End Function '用来打印表的内容，这个是测试用的

Public Function BqSqlExecuteScalar(ByVal sCmdSelect As String) As String

'传一个命令，执行后返回一个

Dim m0 As String = "" '返回值

If IsNothing(sCmdSelect) Then Return m0

Dim m() As String = Split(sCmdSelect)

If InStr("SELECT", UCase$(m(0))) < 1 Then

MMsg("只能执行［SELECT］查询，并返回单值！", 0, 0)

Return m0

End If

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

lcmd.CommandText = sCmdSelect

m0 = "" & lcmd.ExecuteScalar.ToString

lConn.Close()

lConn.Dispose()

Catch ex As Exception '在此处添加错误处理。

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

Return m0

End Function '传一个命令，执行后返回一个

Friend Overloads Function BqSqlExecute(ByVal sCmd As String) As Boolean

'传一个命令

Dim m0 As Boolean = False '返回值

If IsNothing(sCmd) Then Return m0

If Len(Trim(sCmd)) < 5 Then Return m0

Dim m() As String = Split(sCmd)

If InStr("INSERT,DELETE,UPDATE", UCase$(m(0))) < 1 Then

MMsg("只能执行［INSERT,DELETE,UPDATE］查询，并返回所影响的行数！", 0, 0)

Return m0

End If

Dim lConn As New Data.OleDb.OleDbConnection

Dim tran As Data.OleDb.OleDbTransaction

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

tran = lConn.BeginTransaction(IsolationLevel.ReadCommitted)

lcmd.CommandText = sCmd

lcmd.Transaction = tran

m0 = lcmd.ExecuteNonQuery

tran.Commit() '成功就提交，并重新取数

Catch ex As Exception '在此处添加错误处理。

mcSeRRor(ex)

m0 = False

Try

tran.Rollback()

Catch e As Exception

End Try

Finally

tran = Nothing

lConn.Close()

lConn.Dispose()

End Try

Return m0

End Function

Friend Overloads Function BqSqlExecute(ByVal sCmd() As String) As Boolean

'传一组命令

Dim m0 As Boolean = False '返回值

If IsNothing(sCmd) Then Return m0

If sCmd.Length <= 0 Then Return m0

Dim i As Integer

For i = 0 To sCmd.Length - 1

Dim m() As String = Split(sCmd(i))

If InStr("INSERT,DELETE,UPDATE", UCase$(m(0))) < 1 Then

MMsg("只能执行［INSERT,DELETE,UPDATE］查询！", 0, 0)

Return m0

End If

Dim lConn As New Data.OleDb.OleDbConnection

Dim tran As Data.OleDb.OleDbTransaction

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

tran = lConn.BeginTransaction(IsolationLevel.ReadCommitted)

For i = 0 To sCmd.Length - 1

lcmd.CommandText = sCmd(i)

lcmd.Transaction = tran

m0 = lcmd.ExecuteNonQuery

tran.Commit() '成功就提交，并重新取数

Catch ex As Exception '在此处添加错误处理。

mcSeRRor(ex)

m0 = False

Try

tran.Rollback()

Catch e As Exception

End Try

Finally

tran = Nothing

lConn.Close()

lConn.Dispose()

End Try

Return m0

End Function

Public Function BqSqlGetTable(ByVal sCmdSelect As String) As DataTable

Dim ltb As New DataTable

If IsNothing(sCmdSelect) Then Return ltb

If Len(Trim(sCmdSelect)) < 1 Then Return ltb

Dim m() As String = Split(sCmdSelect)

If InStr("SELECT", UCase$(m(0))) < 1 Then

MMsg("只能执行［SELECT］查询！", 0, 0)

Return ltb

End If

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

lcmd.CommandText = sCmdSelect

lAdapter = New System.Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.FillSchema(lDaSet, SchemaType.Mapped) '得到框架结构？？

Dim ldataset As New DataSet

lAdapter.Fill(ldataset)

ltb = ldataset.Tables(0)

Catch ex As Exception '在此处添加错误处理。

Finally

lConn.Close()

lConn.Dispose()

End Try

Return ltb

End Function '单独的查询

Public Overloads Sub BqSqlSetDataSet(ByVal sTableName As String, ByVal sCmdSelect As String)

If IsNothing(sTableName) Then Exit Sub

If IsNothing(sCmdSelect) Then Exit Sub

If Len(Trim(sTableName)) < 1 Then Exit Sub

If Len(Trim(sCmdSelect)) < 1 Then Exit Sub

Dim m() As String = Split(sCmdSelect)

If InStr("SELECT", UCase$(m(0))) < 1 Then

MMsg("只能执行［SELECT］查询！", 0, 0)

Exit Sub

End If

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

lcmd.CommandText = sCmdSelect

lAdapter = New System.Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.FillSchema(lDaSet, SchemaType.Mapped, sTableName) '得到框架结构？？

lAdapter.Fill(lDaSet, sTableName)

Catch ex As Exception '在此处添加错误处理。

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

End Sub '单独的查询

Public Overloads Sub BqSqlSetDataSet(ByVal sTableName As String, ByVal sCmdSelect As String, ByVal sCmdPara(,) As String)

If IsNothing(sTableName) Then Exit Sub

If IsNothing(sCmdSelect) Then Exit Sub

If IsNothing(sCmdPara) Then Exit Sub

If sCmdPara.Rank <> 2 Then

MMsg("参数数组，只能是二维数组，第一列表示参数名，第二列表示对应的值！", 0, 0)

Exit Sub

End If

Dim m() As String = Split(sCmdSelect)

If InStr("SELECT", UCase$(m(0))) < 1 Then

MMsg("只能执行［SELECT］查询！", 0, 0)

Exit Sub

End If

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

lcmd.CommandText = sCmdSelect

Dim i, j As Integer

j = sCmdPara.Length

For i = 0 To j

lcmd.Parameters.Add(sCmdPara(i, 1), sCmdPara(i, 2))

lAdapter = New System.Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.FillSchema(lDaSet, SchemaType.Mapped, sTableName) '得到框架结构？？

lAdapter.Fill(lDaSet, sTableName)

lConn.Close()

lConn.Dispose()

Catch ex As Exception '在此处添加错误处理。

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

End Sub

Public Overloads Sub BqSqlSetDataSet(ByVal sTableName() As String)

If IsNothing(sTableName) Then Exit Sub

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

Dim i, j As Integer

Dim s, sCmd As String

Dim m() As String

j = sTableName.Length '下标个数

For i = 0 To j - 1

s = sTableName(i)

Debug.WriteLine(i & " " & s)

If Not IsNothing(s) Then '如果为空，也不执行

'分两种情况一是第一个单词为select

m = Split(s) '取单词

If InStr("SELECT", UCase$(m(0))) < 1 Then

'如果不包括 Select，则取表名或编码

If mFindTabld(s) = True Then '这个表在数据库中是否存在

sCmd = s

lcmd.CommandType = CommandType.TableDirect

lcmd.CommandText = sCmd

Else '所有编码

sCmd = "SELECT BMBH,BMBH+'-'+BMMC as BMMC FROM K_ZBZ WHERE BMLB= " & Chr(34) & s & Chr(34) & " ORDER BY BMBH"

lcmd.CommandType = CommandType.Text

lcmd.CommandText = sCmd

End If

lAdapter = New System.Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.FillSchema(lDaSet, SchemaType.Mapped, s) '得到框架结构？？

lAdapter.Fill(lDaSet, s)

Else '包括Select命令

sCmd = s

s = "nTalbe" & Trim(Str(i))

lcmd.CommandType = CommandType.Text

lcmd.CommandText = sCmd

lAdapter = New System.Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.FillSchema(lDaSet, SchemaType.Mapped, s) '得到框架结构？？

lAdapter.Fill(lDaSet, s)

End If

Catch ex As Exception

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

End Sub '根据表或查询名来得到数据

Public Overloads Sub BqSqlSetDataSet(ByVal sTableName() As String, ByVal sCmdselect() As String)

End Sub

'''返回表中最大的编号加一的值

Public Overloads Function BqFrtuBh(ByVal cTable As String, ByVal cField As String, ByVal nLen As Integer) As String

'参数：cTable 需要查询的表名

' cField 编号字段名

' a_len 编号字段的长度

Dim lDs As New DataSet

Dim lDataview As New DataView

Dim m, s As String

m = "" '返回值

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

s = "SELECT " & cField & " as bh FROM " & cTable & " order by " & cField

lcmd.CommandText = s

lAdapter = New Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.Fill(lDs, "表")

lDataview = lDs.Tables(0).DefaultView

lDataview.Sort = "bh" '按编号排序

m = rtuBh(nLen, lDataview)

Catch ex As Exception

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

Return m

End Function

Public Overloads Function BqFrtuBh(ByVal cTable() As String, ByVal cField() As String, ByVal nLen As Integer) As String

'参数：cTable 需要查询的表名

' cField 编号字段名

' a_len 编号字段的长度

Dim lDs As New DataSet

Dim lDataview As New DataView

Dim ltb As New DataTable

Dim m, s As String

Dim n, i, k As Integer 'k来保存每个表的记录数

m = Nothing '返回值

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

n = System.Math.Min(cTable.Length, cField.Length)

k = 0

For i = 0 To n - 1

s = "SELECT " & cField(i) & " as bh FROM " & cTable(i) & " order by " & cField(i)

lcmd.CommandText = s

Try

lAdapter = New Data.OleDb.OleDbDataAdapter(lcmd)

lAdapter.Fill(lDs, "表" + i.ToString)

k = System.Math.Max(k, lDs.Tables("表" + i.ToString).Rows.Count)

Catch ex As Exception

mcSeRRor(ex)

End Try

'这句几代码的意思是，找出记录数最多的那一个表

For i = 0 To n - 1 '这样，复制给ltb，再把记录数少的追加到ltb中，速度要快一些

If k = lDs.Tables("表" + i.ToString).Rows.Count Then

ltb = lDs.Tables("表" + i.ToString).Copy

k = i

Exit For

End If

For i = 0 To n - 1 '这样，复制给ltb，再把记录数少的追加到ltb中，速度要快一些

If i <> k Then '由于第k个表的记录数最多，所以就不用把它的记录加入了

For Each r As DataRow In lDs.Tables("表" + i.ToString).Rows

ltb.Rows.Add(r.ItemArray)

End If

lDataview = ltb.DefaultView

lDataview.Sort = "bh" '按编号排序

m = rtuBh(nLen, lDataview)

Catch ex As Exception

Finally

lConn.Close()

lConn.Dispose()

End Try

If IsNothing(m) Then

m = rtuBh(nLen)

End If

Debug.WriteLine(m)

Return m

End Function

'关联表中相应字段中，有没有编号cBh存在，如果有，则返回假，不允许删除

Public Function BqFrtuBhDel(ByVal cTable() As String, ByVal cField() As String, ByVal cBh As String) As Boolean

'参数：cTable 需要查询的表名

' cField 编号字段名

' cBh 需要验证的编号

Dim m As Boolean

Dim i, j, n As Integer '定义循环变量i及当前位置的变量j

Dim s As String

m = True '返回值

Dim lConn As New Data.OleDb.OleDbConnection

Try

lConn.ConnectionString = lConnectionString

lConn.Open()

lcmd = lConn.CreateCommand

n = Math.Min(cTable.GetLength(0), cField.GetLength(0))

For i = 0 To n - 1

s = "SELECT Count(*) AS bh FROM " & cTable(i) & " WHERE " & cField(i) & "= @lczml "

lcmd.CommandText = s

lcmd.Parameters.Add(New OleDb.OleDbParameter("@lczml", OleDb.OleDbType.Char))

lcmd.Parameters("@lczml").Value = cBh

j = lcmd.ExecuteScalar '只返回cBh的记录数就可以了，

If j > 0 Then '如果有记录

m = False '返回假,不允许删除

's = Space(10) & "关联表：" & cTable(i) & Chr(13)

's = s & Space(10) & "关联字段：" & cField(i) & Chr(13) & Chr(13)

's = s & Space(10) & "还存在：【" & cBh & "】这个编号。" & Chr(13) & Chr(13) & Chr(13) & Chr(13)

's = s & Space(17) & "不删除！！！ " & Chr(13) & Chr(13)

's = s & "因为强行删除后，会造成错误的、孤立的数据记录。"

'MMsg(s, 0, 1)

Exit For

End If

Catch ex As Exception

mcSeRRor(ex)

Finally

lConn.Close()

lConn.Dispose()

End Try

Return m

End Function

Public Function BqGetOnelyValue(ByVal sTable As DataTable, ByVal sField As String) As DataTable

Dim ltb0 As New DataTable '输出数据的表

Dim s, sf As String

Dim lyn As Boolean = False '是否有这个字段

If IsNothing(sTable) Then Return Nothing ' 表为空

ltb0 = sTable.Clone '如果表为空，或者没有记录，或者，字段名不存在，都退出，返回一个空表

If sTable.Rows.Count <= 0 Then Return ltb0.Copy '没记录

sf = UCase(Trim(sField)) '得到字段名

If UCase(Trim(sField)).Length < 1 Then Return ltb0.Copy

For Each c As DataColumn In ltb0.Columns '字段是否存在

If UCase(Trim(c.ColumnName)) = sf Then

lyn = True

Exit For

End If

Try

If lyn = True Then '如果有这个字段，才开始判断

sf = Trim(sField) '因为可能有些数据库要区分大小写字母的字段名

'先准备主键及排序视图

Dim lc(0) As DataColumn

Dim ltv As DataView

lc(0) = ltb0.Columns(sf)

ltb0.PrimaryKey = lc '编号必须唯一，这是每个节点的标志

ltv = ltb0.DefaultView

ltv.Sort = sf

'开始判断,并添加记录

Dim r As DataRow

For Each r In sTable.Rows

s = r(sf).ToString

If ltv.Find(s) < 0 And Trim(s).Length > 0 Then

ltb0.Rows.Add(r.ItemArray)

End If

'计算结果的表,按照sf字段进行反序

Dim ltb1 As New DataTable

ltb1 = ltb0.Clone

ltv.Sort = sf

For i As Integer = 0 To ltv.Count - 1

ltb1.Rows.Add(ltv(i).Row.ItemArray)

ltb0 = ltb1.Copy

ltb0.TableName = sTable.TableName & " " & sField

End If

Catch ex As Exception

ltb0 = sTable.Clone

End Try

Return ltb0.Copy

End Function '从数据表中找同字段值不同的记录

Public Overloads Function BqGetStruLike(ByVal sTable As DataTable, ByVal tTable As DataTable) As Boolean

'参数：sTable源数据表，tTable目标数据表,即被比较的

If IsNothing(sTable) = True OrElse IsNothing(tTable) = True Then Return False

Dim m0 As Boolean = True '假设两个是相同的

Dim m As String

Dim lc As DataColumn

For Each lc In sTable.Columns

m = Trim(UCase(lc.ColumnName)) '字段名

If tTable.Columns.IndexOf(m) < 0 Then '只要有一个字段不对，则通出

m0 = False

Exit For

End If

Return m0

End Function '比较两个数据表，如果第一个数据表的字段全部都在第二个表中，则返回true

Public Overloads Function BqGetStruLike(ByVal sTableField() As String, ByVal tTable As DataTable) As Boolean

'参数：sTableField源字段，tTable目标数据表,即被比较的

If IsNothing(sTableField) = True OrElse IsNothing(tTable) = True Then Return False

Dim m0 As Boolean = True '假设两个是相同的

Dim m As String

For Each m In sTableField

If tTable.Columns.IndexOf(m) < 0 Then '只要有一个字段不对，则通出

m0 = False

Exit For

End If

Return m0

End Function '比较两个数据表，如果第一个数据表的字段全部都在第二个表中，则返回true

Private Overloads Function rtuBh(ByVal nlen As Integer, ByVal ltv As DataView) As String

Dim i As Long

Dim m0, n As String

m0 = Nothing

nlen = IIf(nlen > 8 Or nlen < 1, 8, nlen)

If ltv.Table.Rows.Count < 10000 Then

For i = 1 To 100000000 '从 1或 0 开始找 0000一般用于默认设置，

n = Microsoft.VisualBasic.Right(Trim(Str(100000000 + i)), nlen)

If ltv.Find(n) = -1 Then '没有找到了

m0 = n '返回值

Exit For

End If

Else

Do While True '，则按随机原则来取值

i = CInt(Int((Rnd() * 10 ^ (nlen + 1)) + 1))

n = Microsoft.VisualBasic.Right(Trim(Str(1000000000 + i)), nlen)

If ltv.Find(n) = -1 Then '没有找到了

m0 = n '返回值

Exit Do

End If

Loop

End If

Return m0

End Function

Private Overloads Function rtuBh(ByVal nlen As Integer) As String

Dim i As Long

Dim m0, n As String

m0 = Nothing

nlen = IIf(nlen > 8 Or nlen < 1, 8, nlen)

i = CInt(Int((Rnd() * 10 ^ (nlen + 1)) + 1))

n = Microsoft.VisualBasic.Right(Trim(Str(1000000000 + i)), nlen)

m0 = n '返回值

Return m0

End Function

Private Function MDaiOpen(ByVal sCmd As String) As Boolean

Dim m0 As Boolean = False

Dim m() As String = Split(sCmd)

If InStr("INSERT,DELETE,UPDATE", UCase$(m(0))) < 1 Then

MMsg("只能执行［INSERT,DELETE,UPDATE］查询，并返回所影响的行数！", 0, 0)

Return m0

End If

If IsNothing(ldailConn) Or ldailYN = False Or ldailConnectionString = "" Then

Return m0

End If

Try

With ldailConn

.Close()

.ConnectionString = ldailConnectionString

.Open()

m0 = True

Return m0

End With

Catch ex As Exception

End Try

Return m0

End Function

Private Function mFindTabld(ByVal sTableName As String) As Boolean '查找数据库中是否有该表或查询

Dim m0 As Boolean = False

Try

If Not IsNothing(lSchemaTable) Then

If lSchemaTable.Rows.Count > 0 Then

Dim r As DataRow

For Each r In lSchemaTable.Rows

If Trim(UCase(sTableName)) = Trim(UCase(r("TABLE_NAME"))) Then

m0 = True

Exit Try

End If

Catch ex As Exception

End Try

Return m0

End Function

'登录操作日志，

'第一个，直接执行一个命令；

'第二个，当前插入新记录后，可返回最新的自动编号的值

'第三个，执行有参数的命令，由于这是日专专用的，所以参数名是@lczml,只需要传入参数的值

Friend Overloads Function BqDail(ByVal sCmd As String)

If MDaiOpen(sCmd) = True Then

Try

lcmd = ldailConn.CreateCommand

With lcmd

.CommandText = sCmd

.ExecuteNonQuery()

End With

Catch ex As Exception '在此处添加错误处理。

End Try

End If

ldailConn.Close()

End Function

Public Overloads Function BqDail(ByVal sCmd As String, ByVal bReturnIDentity As Boolean) As Long

Dim m0 As Long = -1 '返回当前的ID编号

If MDaiOpen(sCmd) = True Then

Try

lcmd = ldailConn.CreateCommand

With lcmd

.CommandText = sCmd

.ExecuteNonQuery()

If bReturnIDentity = True Then

Dim s As String

s = "select @@IDentity "

.CommandText = s

m0 = .ExecuteScalar

End If

End With

Catch ex As Exception '在此处添加错误处理。

End Try

End If

ldailConn.Close()

Return m0

End Function

Friend Overloads Function BqDail(ByVal sCmd As String, ByVal sCmdPara_Lczml_Value As String)

If MDaiOpen(sCmd) = True Then

Try

lcmd = ldailConn.CreateCommand

With lcmd

.CommandText = sCmd

.Parameters.Add(New OleDb.OleDbParameter("@lczml", OleDb.OleDbType.Char))

.Parameters("@lczml").Value = sCmdPara_Lczml_Value

.ExecuteNonQuery()

End With

Catch ex As Exception '在此处添加错误处理。

End Try

ldailConn.Close()

End If

End Function

Private Function mcSeRRor(ByVal ex As Exception) As Integer

Dim s As String = ""

Dim n As Integer

'正式使用的时候，这个一定要改一下,只笼统地写个错误即可

s = "BqDataClass "

s += " Message： " & ex.Message & vbCrLf & vbCrLf & vbCrLf & vbCrLf

s += " StackTrace： " & vbCrLf & ex.StackTrace & vbCrLf

n = MessageBox.Show(s, "Microsof System.Data.OleDb ", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1)

If n = DialogResult.Abort Then

System.Environment.Exit(0)

End If

Return n

End Function

End Class

cdbqss1

发布了24 篇原创文章 · 获赞 5 · 访问量 6万+

私信关注

猜你喜欢