数据备份和恢复

Question

vb里面对数据库里面的数据进行操作--数据备份和恢复

Answer 1

引用
    Microsoft Jet and Replication Objects 2.6 Library对mdb数据库进行压缩备份 Public Function CompareDB() As Integer
On Error GoTo CompareDB_Error
    
    Dim oJro                    As New JRO.JetEngine
    Dim ls                      As String......    oJro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ls, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & MDBFile    GoTo WayOut
CompareDB_Error:
WayOut:
End Function

Answer 2

'------------------------------ 注释 啊凯 -------------------------------
'名称: 数据库对象类
'功能: 管理数据库初化，连接，及查询
'备注:
'      ParameterArray   0 ServerName 1 UserID 2 PWD 3 DBName
'                       0 DBPath 1 UserID 2 PWD
'-------------------------------------------------------------------Option ExplicitPublic Enum EnDBType
    dbSQLServer = 0
    dbAccess = 1
End EnumPublic Enum EnShowFormType
    sftShow = 0
    sftNoShow = 1
    sftSystem = 2
End EnumPrivate Const ConstDBConfig = "ConnLibrary.ini"
Private Const SQLConnString = "Provider=SQLOLEDB;Data Source="
Private Const AccessConnString = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="Private FConn As ADODB.Connection
Private FIsConnect As Boolean
Private FDBType As EnDBType
Private FCommand As ADODB.Command
Private ParameterArray() As StringPrivate RestoreConnString As String
Private ConnString As StringDim i As Long'数据库连接对象：
Public Property Get Conn() As ADODB.Connection
    Set Conn = FConn
End Property'连接数据库：
Public Function Connect(Optional ShowForm As EnShowFormType = sftSystem) As Boolean
    Dim tStr As String
    Dim tBool As Boolean
    Dim tArray() As String
    tBool = False
    ReadConfig
    If ShowForm = sftSystem Then
        If ParameterArray(0) = "0" Then ShowForm = sftShow
    End If
    If ShowForm = sftShow Then
        tArray = DBLoginForm.Connect(ParameterArray)
        If tArray(0) <> 0 Then
            ParameterArray = tArray
        End If
    End If
    If ParameterArray(0) = "0" Then
        Connect = False
        Exit Function
    End If
    tBool = TestConnect(ParameterArray, True)
    If tBool Then
        WriteConfig
        FConn.CursorLocation = adUseClient
        Set FCommand.ActiveConnection = FConn
        
    End If
    Connect = tBool
End Function'数据库是否已经连接：
Public Property Get IsConnect() As Boolean
    IsConnect = FIsConnect
End Property'数据库类型属性：
Public Property Get DBType() As EnDBType
    DBType = FDBType
End Property'测试数据库连接：
Public Function TestConnect(ParameterArray() As String, Optional isApp As Boolean = False) As Boolean
    On Error GoTo ErrTag
    Dim tConn As ADODB.Connection
    'Dim tConnString As String
    If ParameterArray(0) = "1" Then
        ConnString = SQLConnString & ParameterArray(1) & ";Initial Catalog="
        RestoreConnString = ConnString
        
        ConnString = ConnString & ParameterArray(4) & ";User Id=" & ParameterArray(2)
        RestoreConnString = RestoreConnString & "master;User Id=" & ParameterArray(2)
        
        ConnString = ConnString & ";Password=" & ParameterArray(3)
        RestoreConnString = RestoreConnString & ";Password=" & ParameterArray(3)
    Else
        ConnString = AccessConnString & ParameterArray(1) & ";pwd=" & ParameterArray(3)
    End If
    
    If isApp Then
        FConn.Open ConnString
    Else
        Set tConn = New ADODB.Connection
        tConn.Open ConnString
        tConn.Close
    End If
    'RestoreConnString
    Set tConn = Nothing
    TestConnect = True
    Exit Function
ErrTag:
    TestConnect = False
    TestConnect = False
    WinApp.MsgBox "数据库连接失败，原因：" & Err.Description
End FunctionPrivate Sub Class_Initialize()
    Set FConn = New ADODB.Connection
    Set FCommand = New ADODB.Command
    ReDim ParameterArray(4)
End SubPrivate Sub Class_Terminate()
    If FConn.State <> 0 Then FConn.Close
    Set FConn = Nothing
End Sub'执行SQL语句：
Public Function ExeSQL(SQLStr As String) As Boolean
On Error GoTo ErrTag
    Dim tLong As Long
    ExeSQL = True
    FConn.Execute SQLStr, tLong, adCmdText
    If tLong = 0 Then ExeSQL = False
    Exit Function
ErrTag:
    MsgBox Err.Description
    ExeSQL = False
End Function'查询数据库返回Boolean
Public Function QueryBool(SQLStr As String) As Boolean
On Error GoTo ErrTag
    Dim Rs As New ADODB.Recordset
    QueryBool = True
    Set Rs = FConn.Execute(SQLStr, , adCmdText)
    If Rs.RecordCount < 1 Then
        QueryBool = False
    End If
    Rs.Close
    Set Rs = Nothing
ErrTag:
    QueryBool = False
    Set Rs = Nothing
End Function

Answer 3

'查询并返回记录：
Public Function QueryStr(SQLStr As String, Field() As String) As Boolean
On Error GoTo ErrTag
    Dim Rs As New ADODB.Recordset
    QueryStr = True
    'SQLStr = "select * from staff where operno='0001'"
    Rs.Open SQLStr, Conn, adOpenStatic, adLockOptimistic
    If Rs.RecordCount < 1 Then
        QueryStr = False
    Else
        For i = 0 To UBound(Field)
            If IsNull(Rs(Field(i, 0))) = False Then
                Field(i, 1) = Rs(Field(i, 0))
            Else
                Field(i, 1) = ""
            End If
        Next
    End If
    Rs.Close
    Set Rs = Nothing
    Exit Function
ErrTag:
    QueryStr = False
    Set Rs = Nothing
End Function'写配置文件：
Private Sub WriteConfig()
    Dim cFile As String
    cFile = App.Path + "\" + ConstDBConfig
    INI_Write cFile, "DataBase", "DbType", ParameterArray(0)
    
    INI_Write cFile, "DataBase", "Parameter1", ParameterArray(1)
    INI_Write cFile, "DataBase", "Parameter2", ParameterArray(2)
    INI_Write cFile, "DataBase", "Parameter3", ParameterArray(3)
    
    If ParameterArray(0) = "1" Then
        INI_Write cFile, "DataBase", "Parameter4", ParameterArray(4)
    End If
End Sub'读配置文件：
Private Sub ReadConfig()
    Dim cFile As String, tStr As String
    ParameterArray(0) = 0
    cFile = App.Path + "\" + ConstDBConfig
    If Dir(cFile) = "" Then Exit Sub
    
    ParameterArray(1) = INI_Read(cFile, "DataBase", "Parameter1")
    If ParameterArray(1) = "" Then Exit Sub
    
    tStr = INI_Read(cFile, "DataBase", "DbType")
    If tStr <> "1" And tStr <> "2" Then Exit Sub
    
    If tStr = 1 Then
        ParameterArray(2) = INI_Read(cFile, "DataBase", "Parameter2")
        If ParameterArray(2) = "" Then Exit Sub
        
        ParameterArray(4) = INI_Read(cFile, "DataBase", "Parameter4")
        If ParameterArray(4) = "" Then Exit Sub
    End If
    ParameterArray(3) = INI_Read(cFile, "DataBase", "Parameter3")
    ParameterArray(0) = tStr
    
End Sub'检测数据表是否完整,不完整就建立：
Public Function CheckTable(Tables() As String) As Boolean
On Error GoTo ErrTag
    Dim Rs As New ADODB.Recordset
    Set Rs = FConn.OpenSchema(adSchemaTables)
    CheckTable = True
    For i = 0 To UBound(Tables)
        Rs.Find "TABLE_NAME='" & Tables(i) & "'"
        If Rs.EOF Then
            InitTable Tables(i)
        End If
        Rs.MoveFirst
    Next
    Rs.Close
    Set Rs = Nothing
    Exit Function
ErrTag:
    CheckTable = False
    Set Rs = Nothing
End Function'建立数据库：
Public Function CreateDatabase(ServerName As String, UserID As String, Pwd As String, _
                               DdName As String, SqlFilePath As String) As Boolean    Dim GOBJServer As New SQLDMO.SQLServer
    Dim UstrSQlScript As String, lStrLine
    Dim LOBJDatabase As New SQLDMO.Database
    Dim LObjDBF As New SQLDMO.DBFile
    
    GOBJServer.LoginTimeout = 10
    GOBJServer.Connect ServerName, UserID, Pwd    LOBJDatabase.Name = DdName    LObjDBF.Name = DdName
    LObjDBF.PhysicalName = GOBJServer.Registry.SQLDataRoot & "\DATA\" & DdName & ".dbf"  '文件名称
    LObjDBF.Size = 10    '初始大小10M
    LObjDBF.FileGrowthType = SQLDMOGrowth_Percent '增长方式为按比例
    LObjDBF.FileGrowth = 5 '增长5%
    LOBJDatabase.FileGroups("PRIMARY").DBFiles.Add LObjDBF   '将数据库文件绑定到数据库    '建立日志文件
     Dim lOBJLogF As New SQLDMO.LogFile
     lOBJLogF.Name = DdName & "_Log.ldf"
     lOBJLogF.PhysicalName = GOBJServer.Registry.SQLDataRoot & "\DATA\" & DdName & "_log.ldf" '文件名称
     lOBJLogF.Size = 5  '初始大小5M
     LOBJDatabase.TransactionLog.LogFiles.Add lOBJLogF    '将日志文件增加到数据库     '将数据库添加到服务器
     GOBJServer.Databases.Add LOBJDatabase    'Dim lObjLogin As New SQLDMO.Login   '登录用户对象
    'Dim lObjUser As New SQLDMO.User     '数据库用户对象
    
    'lObjLogin.Name = Trim(txtUserName.Text) '指定用户登录名
    'lObjLogin.Database = CboDatabases.Text '默认登录数据库
    'lObjLogin.DenyNTLogin = False          '非NT系统登录
    'GOBJServer.Logins.Add lObjLogin        '添加登录用户
    'lObjLogin.SetPassword "", Trim(txtPwd.Text) '指定密码
    'GOBJServer.ServerRoles(1).AddMember Trim(txtUserName.Text) '指定用户为超级用户
    'lObjUser.Name = lObjLogin.Name          '指定用户名
    'lObjUser.Login = lObjLogin.Name         '    'GOBJServer.Databases(CboDatabases.Text).Users.Add lObjUser '为系统数据库添加该新用户
    
    Open SqlFilePath For Input As #1
    Do While Not EOF(1)
        Line Input #1, lStrLine
        UstrSQlScript = UstrSQlScript + lStrLine + (Chr(13) + Chr(10))
    Loop
    Close #1    '执行脚本建立数据库
    GOBJServer.Databases(DdName).ExecuteImmediate UstrSQlScript, SQLDMOExec_Default
    
End Function

Answer 4

'用脚本文件初始化数据库：
Public Function InitializeDatabase(ServerName As String, UserID As String, Pwd As String, _
                                   SqlFilePath As String) As Boolean
On Error GoTo ErrorHandler
    Dim GOBJServer As New SQLDMO.SQLServer
    Dim UstrSQlScript As String, lStrLine
    GOBJServer.LoginTimeout = 10
    GOBJServer.Connect ServerName, UserID, Pwd
    
    Open SqlFilePath For Input As #1
    Do While Not EOF(1)
        Line Input #1, lStrLine
        UstrSQlScript = UstrSQlScript + lStrLine + (Chr(13) + Chr(10))
    Loop
    Close #1
    
    GOBJServer(1).ExecuteImmediate UstrSQlScript
    InitializeDatabase = True
    Set GOBJServer = Nothing
    Exit Function
    
ErrorHandler:
    InitializeDatabase = True
    Set GOBJServer = Nothing
End FunctionPublic Function Execute(SQLStr As String) As ADODB.Recordset
   Set Execute = FConn.Execute(SQLStr, , adCmdText)
End Function'保存图片到数据库中：
Public Function SavePic(FileName As String, iGuid As String, _
                        Optional OpType As EnOpType = eotAdd) As Boolean
'On Error GoTo ErrorHand
    Dim Rs As New ADODB.Recordset
    Dim mstream As New ADODB.Stream
    Dim strSQL As String
    SavePic = False
    If UCase(Right(FileName, 3)) = "JPG" Or UCase(Right(FileName, 3)) = "BMP" Then
        mstream.Type = adTypeBinary
        mstream.Open
        mstream.LoadFromFile FileName
    Else
        WinApp.MsgBox "选择图片格式不对,请重新选择!"
        Set Rs = Nothing
        Set mstream = Nothing
    End If
    
    If OpType = eotAdd Then
        strSQL = "SELECT * FROM Image"
        Rs.Open strSQL, FConn, adOpenDynamic, adLockOptimistic
        Rs.AddNew
    Else
        strSQL = "SELECT * FROM Image WHERE iGuid='" & iGuid & "'"
        Rs.Open strSQL, Conn, adOpenDynamic, adLockOptimistic
        If Rs.EOF Then
            Set Rs = Nothing
            Exit Function
        End If
    End If
    Rs!iGuid = iGuid
    Rs!IPicture = mstream.Read
    Rs.Update
    Rs.Close
    mstream.Close
    Set Rs = Nothing
    Set mstream = Nothing
    SavePic = True
    Exit Function
'ErrorHand:
    SavePic = False
End Function'从数据库中读取图片：
Public Function LoadDBPic(iGuid As String) As String
'On Error GoTo ErrorHand
    Dim FilePath As String, strSQL As String
    Dim mstream As New ADODB.Stream
    Dim Rs As New ADODB.Recordset
    LoadDBPic = ""
    strSQL = "SELECT * FROM Image WHERE iGuid='" & iGuid & "'"
    Rs.Open strSQL, Conn
    If Not Rs.EOF Then
        mstream.Type = adTypeBinary
        mstream.Open
        If Not IsNull(Rs!IPicture) Then            FilePath = WinApp.BackupIniDir & "\" & Trim(Rs!iGuid) & ".bmp"
            mstream.Write Rs!IPicture
            mstream.SaveToFile FilePath, adSaveCreateOverWrite
            LoadDBPic = FilePath
        End If
    End If
    mstream.Close
    Set mstream = Nothing
    Rs.Close
    Set Rs = Nothing
    Exit Function
ErrorHand:
    LoadDBPic = ""
End FunctionPublic Function RestoreConn() As String
'On Error GoTo ErrorHand
    If FConn.State <> 0 Then FConn.Close
    'FConn.Open RestoreConnString
    'Exit Function
    RestoreConn = RestoreConnString
'ErrorHand:
    'FConn.Open ConnString
End FunctionPublic Sub DefaultConn()
On Error Resume Next
    If FConn.State <> 0 Then FConn.Close
    FConn.Open ConnString
End Sub

Answer 5

************************通用声明部分********************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
******************************模块部分******************************************Option Explicit
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As LongPublic Function ExecuteSQL(sql As String) As ADODB.Recordset
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim msg As String
On Error GoTo executesql_error
Set cn = New ADODB.Connection
cn.Open "Driver={SQL Server};Server=LPY;Uid=sa;Pwd=;database=CY"
Set rst = New ADODB.Recordset
rst.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
Set ExecuteSQL = rst
executesql_exit:
Set rst = Nothing
Set cn = Nothing
Exit Function
executesql_error:
msg = "错误原因：" & err.Description
Resume executesql_exit
End Function
************************************数据备份**************************************
Private Sub cmd_backup_Click()
If Trim(txt_route.Text) = "" Then
MsgBox "不输入存储路径与文件名称你备份什么啊~？", vbInformation + vbOKOnly, "警告"
Exit Sub
Else
sql = "backup database CY to disk = '" & Trim(txt_route.Text) & "
Set rs = ExecuteSQL(sql)
MsgBox "恭喜、恭喜，您备份数据库成功~！~", vbInformation + vbOKOnly, "备份成功"
txt_route.Text = ""
End If
cmd_backup.Enabled = False
txt_route.Text = ""
frm_data.Hide
End Sub*********************************数据还原***************************************
Private Sub cmd_restore_Click()
sta.Visible = True
sta.Panels(1).Text = "目前正在恢复数据库，请稍后、、、"Dim cn As ADODB.Connection
Dim s_restore As String
Shell "scm -silent 1 -action 2  -service mssqlserver -Server LPY" 'Specfied sqlserver service
Sleep 20000
Set cn = New ADODB.Connection
cn.Open "Driver={SQL Server};Server=LPY;Uid=sa;Pwd=;database=CY"
        cn.Execute "use master"
        s_restore = "restore database CY from disk='" + Trim(txt_rroute.Text) + "'"
        cn.Execute s_restore
cn.Close
err.Number = 0
If err.Number = 0 Then
MsgBox "恭喜、恭喜，您恢复数据库成功~！~", vbInformation + vbOKOnly, "恢复成功"
Else
MsgBox "不好意思，您恢复数据库失败~！~", vbInformation + vbOKOnly, "恢复失败"
End Iftxt_rroute.Text = ""
cmd_restore.Enabled = False
sta.Panels(1).Text = ""
frm_data.Hide
Exit Sub
End Sub

Answer 6

使用sqldmo恢复
http://www.ourfly.com/forum/View.aspx?fbId=9&Id=146