VB6-操作数据库
平常搞数据库操作多了就想把经常用的内容放在一起，我也懒，在一本书里的工程例子挑了一个bas，修修改改，凑合这用吧。
1 Public strCnn As String '数据库连接字符串 2 Public AdoCnn As ADODB.Connection '数据库连接 3 Public IsConnect As Boolean '判断是否连接 4 5 6 Private Sub Connect() '连接数据库 7 On Error GoTo Err: 8 If IsConnect = True Then '如果连接标记为真，则返回。否则会出错 9 Exit Sub 10 End If 11 12 Set AdoCnn = New ADODB.Connection '关键New用于创建新对象cnn 13 With AdoCnn 14 .ConnectionString = strCnn 15 .ConnectionTimeout = 10 16 .Open 17 End With 18 IsConnect = True '设置连接标记，表示已经连接到数据库 19 Exit Sub 20 Err: 21 If Err = -2147467259 Then 22 Set Cnn = Nothing 23 MsgBox Err.Description & "请检查数据库配置!", vbOKOnly + vbInformation, "Connect" 24 Else 25 MsgBox Err.Description & "请检查数据库配置!", vbExclamation, "Connect" 26 End If 27 28 End Sub 29 30 Public Sub Disconnect() '断开与数据库的连接 31 Dim rc As Long 32 If IsConnect = False Then Exit Sub '如果连接标记为假，标明已经断开连接，则直接返回 33 AdoCnn.Close '关闭连接 34 35 Set AdoCnn = Nothing 36 IsConnect = False 37 End Sub 38 39 Public Sub DB_Connect() '使用Connect_Num控制数据库连接 40 Connect_Num = Connect_Num + 1 41 Connect 42 End Sub 43 44 Public Sub DB_Disconnect() 45 If Connect_Num >= CONNECT_LOOP_MAX Then 46 Connect_Num = 0 47 Disconnect 48 End If 49 End Sub 50 51 Public Sub DBapi_Disconnect() '强制关闭api方式访问的数据库，计数器复位 52 Connect_Num = 0 53 Disconnect 54 End Sub 55 56 Public Sub ExecSql(ByVal TmpSql As String) '执行数据库操作语句 57 On Error GoTo Err: 58 Dim cmd As New ADODB.Command '创建Command对象cmd 59 DB_Connect '连接到数据库 60 Set cmd.ActiveConnection = AdoCnn '设置cmd的ActiveConnection属性，指定与其关联的数据库连接 61 cmd.CommandText = TmpSql '设置要执行的命令文本 62 cmd.Execute 63 Set cmd = Nothing 64 DB_Disconnect 65 Exit Sub 66 Err: 67 MsgBox Err.Description, 64, "ExecSql" 68 End Sub 69 70 Public Function QuerySql(ByVal TmpSql As String) As ADODB.Recordset '执行数据库查询语句 71 On Error GoTo Err: 72 Dim rst As New ADODB.Recordset 73 DB_Connect '连接到数据库 74 If IsConnect = False Then Exit Function 75 Set rst.ActiveConnection = AdoCnn '设置rst的ActiveConnection属性，指定与其关联的数据库连接 76 rst.CursorType = adOpenKeyset 77 rst.LockType = adLockOptimistic '设置锁定类型 78 rst.Open TmpSql '打开记录集 79 Set QuerySql = rst '返回记录集 80 Exit Function 81 Err: 82 MsgBox Err.Description, 64, "QuerySql" 83 End Function 84 85 Public Function GetFieldValue(FieldValue As Variant) As String 86 GetFieldValue = IIf(Not IsNull(FieldValue), FieldValue, "") 87 End Function
