VB连SQL数据库.doc

VB连SQL数据库 Public conbook As ADODB.Connection '声明全局的连接对象变量Public Sub Main() '入口程序 Dim bln As Boolean bln = opensqlserver If bln = True Then On Error GoTo connerr End If Dim s As String Dim fn As String '文件名 '如果数据库booksystem已经存在，先删除conbook.Execute ("IF EXISTS (SELECT name FROM master.dbo.sysdatabases WHERE name = 'booksystem') EXEC sp_detach_db 'booksystem', 'true'")'查找数据库文件是否存在，如果存在则根据文件附加数据库If Dir(App.Path & "\database\*.mdf") <> "" And Dir(App.Path & "\database\*.ldf") <> "" Then '存在时根据文件附加数据库 s = "exec sp_attach_db @dbname='booksystem', @filename1= '" & App.Path & "\database\booksystem_data.mdf', @filename2='" & App.Path & "\database\booksystem_log.ldf'" conbook.Execute (s) '附加数据库Else '数据库文件不存在，则先查找备份文件是否存在，如果存在，根据备份还原数据库 fn = Dir(App.Path & "\database\*.dat") If fn <> "" Then s = "restore database booksystem from disk='" & App.Path & "\database\" & fn & "' with recovery,move 'booksystem_data' to '" & _ App.Path & "\database\booksystem_data.mdf' ,move 'booksystem_log' to '" & App.Path & "\database\booksystem_log.ldf'" conbook.Execute s '恢复数据库到工程路径 Else '备份文件不存在，则先根据sql语句创建数据库 Call createdb '调用过程，创建数据库 End IfEnd If'附加成功后将当前数据库设置为studentconbook.Execute ("use booksystem") frmStar.Show 'MDIMain.ShowExit Subconnerr:MsgBox Err.DescriptionEnd Sub'自定义函数，打开和SQL数据库的连接Public Function opensqlserver() As BooleanOn Error GoTo conerr Set conbook = New ADODB.Connection With conbook .Provider = "sqloledb" .ConnectionTimeout = 30 .CommandTimeout = 30 .ConnectionString = "data source=.;user id=sa;password=;database=master" '连接字符串 .Open End With opensqlserver = True Exit Functionconerr: MsgBox "数据库连接失败！" & Err.Description opensqlserver = FalseEnd FunctionPublic Function rsopen(rs As ADODB.Recordset, sql As String) As BooleanOn Error GoTo rserr '分配内存 Set rs = New ADOD