VB操作数据库的基本函数模块

BackTransparentImage_Module

Option Explicit

Public Conn As New ADODB.Connection

Public Rs As New ADODB.Recordset '临时表 '三个系统表

Public UserTable As New ADODB.Recordset '用户表

Public OpeRecord As New ADODB.Recordset '操作记录表 Public TablesInfo As New ADODB.Recordset '操作表信息

Public Type TabaleRecordsets TNumber As Long TName As String

TRecordset As ADODB.Recordset End Type

Public TRS() As TabaleRecordsets

Public Function OpenDataBase(ByVal Path As String, ByVal PassWord As String) As Long Dim i As Long

On Error GoTo errHandle '打开数据库

If Trim(PassWord) = \

Conn.ConnectionString = \& \ Else

Conn.ConnectionString = \& \ End If

Conn.Open

'活动三个系统表

UserTable.Open \ OpeRecord.Open \* from OpeRecords\Conn, adOpenDynamic, adLockPessimistic

TablesInfo.Open \ '得到数据表数组 ReDim TRS(0): i = 0

If TablesInfo.EOF <> True And TablesInfo.BOF <> True Then TablesInfo.MoveFirst

Do While Not TablesInfo.EOF

TRS(i).TName = TablesInfo.Fields(\ TRS(i).TNumber = i

TRS(i).TRecordset.Open \* from \& TRS(i).TName, Conn, adOpenDynamic, adLockPessimistic TablesInfo.MoveNext

If Not TablesInfo.EOF Then i = i + 1

ReDim Preserve TRS(i) Else

Exit Do End If Loop

'反馈操作结果

If Conn.State = adStateOpen Then OpenDataBase = 1

MsgBox \成功打开数据库\ Else

GoTo errHandle End If

Exit Function errHandle:

MsgBox \打开数据库时发生错误:\ \vbOKOnly + vbCritical, \发生错误\End Function

'加载图片到数据库

Public Function LoadPicToDatabase(ByVal PicFileName As String) As Long Dim MStream As New ADODB.Stream MStream.Type = adTypeBinary MStream.Open

MStream.LoadFromFile FileName

Rs.Fields(\ Rs.Update

MStream.Close End Function

'从数据库中输出图片

Public Function OutPicFromDatabase() As Picture Dim stmpic As New ADODB.Stream Dim StrPicTemp As String

If Not IsNull(Rs.Fields(\

StrPicTemp = App.Path & \临时文件,用来保存读出的图片 With stmpic

.Type = adTypeBinary .Open '打开

.Write Rs.Fields(\写入数据库中的二进制文件 .SaveToFile StrPicTemp, adSaveCreateOverWrite .Close End With

Set OutPicFromDatabase = LoadPicture(StrPicTemp) Kill StrPicTemp

End Function '用户登录

Public Function UserLand(ByVal UName As String, ByVal UPassWord As String) As Boolean UserTable.MoveFirst

UserTable.Find \ If UserTable.EOF Then MsgBox \没有该用户\ Exit Function Else

If UserTable.Fields(\ UserLand = True Else

MsgBox \密码不正确\ Exit Function End If End If End Function '关闭数据库

Public Function CloseDataBase() As Boolean Dim i As Integer, u As Integer u = UBound(TRS) For i = 0 To u Step 1

TRS(i).TRecordset.Close

Set TRS(i).TRecordset = Nothing Next i

UserTable.Close

Set UserTable = Nothing OpeRecord.Close

Set OpeRecord = Nothing TablesInfo.Close

Set TablesInfo = Nothing Conn.Close

Set Conn = Nothing End Function

本文来源：https://www.bwwdw.com/article/msvv.html