问：在VB中可以通过sqldmo实现对sqlserver数据库备份，而且有进度条,但源码我看不懂。。

部分源码如下：
Option ExplicitDim gSQLServer As SQLDMO.SQLServer'这一句定义我也明白，WidthEvents是什么意思？？？？Dim WithEvents oBackupEvent As SQLDMO.Backup
Private Sub cmdBackup_Click()
    On Error GoTo ErrHandler:
    
    Dim oBackup As SQLDMO.Backup
    
    gDatabaseName = cmbDatabaseName.Text
    Set oBackup = New SQLDMO.Backup
    
    '这一句我不懂哎呀。。是什么意思？是给oBackup对象增加一个事件吗？    Set oBackupEvent = oBackup ' enable events
    
    oBackup.Database = gDatabaseName
    gBkupRstrFileName = txtDataFileName.Text
    oBackup.Files = gBkupRstrFileName
    
    ' Delete the datafile to allow the application to create a brand new file.
    ' This will prevent attaching the new backup data to the old data if there
    ' is any.
    If Len(Dir(gBkupRstrFileName)) > 0 Then
        Kill (gBkupRstrFileName)
    End If
    
    ' Change mousepointer while trying to connect.
    Screen.MousePointer = vbHourglass
    
    ' Backup the database.
    oBackup.SQLBackup gSQLServer
    
    ' Change mousepointer back to the default after connect.
    Screen.MousePointer = vbDefault
   
    Set oBackupEvent = Nothing ' disable events
    Set oBackup = Nothing
    
    Exit SubErrHandler:
    MsgBox "Error " & Err.Description
    Resume Next
End SubPrivate Sub oBackupEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
    PrintStat "oBackupEvent_PercentComplete -- " & Message & " " & Percent
End Sub我想把它转成delphi的，备份部分已经实现，可就是进度条部分实现不了，主要是给oBackUp这个对象引入CompletePercent这个事件哪位兄弟帮忙一下。谢谢。。

解决方案 »

  1.   

    Dim WithEvents oBackupEvent As SQLDMO.Backup
    是自定义一个事件呀
    VB的基本语法，你看看MSDN，或则找找书看看就知道了
    Set oBackup = New SQLDMO.Backup
        
        '这一句我不懂哎呀。。是什么意思？是给oBackup对象增加一个事件吗？    Set oBackupEvent = oBackup ' enable events
        
    这里不是说的很清楚吗，这是激活这个事件呀，不过好像标准的激活事件不是这么做的
      

  2.   

    具体的你去找找书看看吧，很多书都会介绍的，有其是关于用VB进行Active控件设计书。
      

  3.   

    我是搞delphi的，所以看VB的代码，很多看不懂，这是sqlserver带的一个例子， 唉，用VB可以实现，用delphi就是不能呀，这个事件如何也加不上。。
      

  4.   

    Option ExplicitDim gSQLServer As SQLDMO.SQLServer
    Dim WithEvents oBackupEvent As SQLDMO.Backup
    Dim WithEvents oRestoreEvent As SQLDMO.RestoreDim gbConnected As Boolean
    Dim gDatabaseName As String
    Dim gBkupRstrFileName As String
    Dim gBkupRstrFilePath As StringConst gTitle = "Server Connection"Private Sub Form_Load()
        Set gSQLServer = Nothing
        optWinNTAuth.Value = True
        gbConnected = False
        WinNTAuthOptionsOn
        buttonsConnectClosed
    End SubPrivate Sub Form_Unload(Cancel As Integer)
        If gbConnected = True Then
            Call gSQLServer.DisConnect
        End If
        If Not gSQLServer Is Nothing Then
            Set gSQLServer = Nothing
        End If
    End SubPrivate Sub cmdConnect_Click()
        Dim ServerName As String
        Dim UserName As String
        Dim Password As String    On Error GoTo ErrHandler:    If gSQLServer Is Nothing Then
            Set gSQLServer = New SQLDMO.SQLServer
        End If
        
        ' Put text box values into connection variables.
        ServerName = txtServerName.Text
        UserName = txtUserName.Text
        Password = txtPassword.Text
         
        ' Set the login timeout.
        gSQLServer.LoginTimeout = 15
        
        ' Decision code for login authorization type: WinNT or SQL Server.
        If optWinNTAuth.Value = True Then
            gSQLServer.LoginSecure = True
        End If
        
        ' Change mousepointer while trying to connect.
        Screen.MousePointer = vbHourglass
        
        gSQLServer.Connect ServerName, UserName, Password
        gbConnected = True
        
        ' List all of the database names.
        FillDatabaseList
        
        ' Change mousepointer back to the default after connect.
        Screen.MousePointer = vbDefault
        
        ' Notify user that connection was successful.
        MsgBox "Connection to server successful.", vbOKOnly, gTitle
        
        buttonsConnectOpen
        
        ' Clear up the status text in the "result field".
        txtStatus.Text = ""
        
        Exit SubErrHandler:
        MsgBox "Error " & Err.Description
        
        ' Change mousepointer back if it's hourglass.
        If Screen.MousePointer = vbHourglass Then
            Screen.MousePointer = vbDefault
        End If
        
    End SubPrivate Sub cmdDisconnect_Click()
        On Error GoTo ErrHandler:
        
        Dim Msg As String
        Dim Response As String    ' Disconnect from a connected server.
        If gbConnected = True Then
            Msg = "Disconnect from Server?"
            Response = MsgBox(Msg, vbOKCancel, gTitle)
            If Response = vbOK Then
                Call gSQLServer.DisConnect
                Set gSQLServer = Nothing
                cmbDatabaseName.Clear
                txtDataFileName.Text = ""
                txtStatus.Text = ""
                gbConnected = False
                buttonsConnectClosed
            End If
        End If
        
        Exit Sub
        
    ErrHandler:
        MsgBox "Error " & Err.Description
        Resume Next
    End SubPrivate Sub cmdBackup_Click()
        On Error GoTo ErrHandler:
        
        Dim oBackup As SQLDMO.Backup
        
        gDatabaseName = cmbDatabaseName.Text
        Set oBackup = New SQLDMO.Backup
        Set oBackupEvent = oBackup ' enable events
        
        oBackup.Database = gDatabaseName
        gBkupRstrFileName = txtDataFileName.Text
        oBackup.Files = gBkupRstrFileName
        
        ' Delete the datafile to allow the application to create a brand new file.
        ' This will prevent attaching the new backup data to the old data if there
        ' is any.
        If Len(Dir(gBkupRstrFileName)) > 0 Then
            Kill (gBkupRstrFileName)
        End If
        
        ' Change mousepointer while trying to connect.
        Screen.MousePointer = vbHourglass
        
        ' Backup the database.
        oBackup.SQLBackup gSQLServer
        
        ' Change mousepointer back to the default after connect.
        Screen.MousePointer = vbDefault
       
        Set oBackupEvent = Nothing ' disable events
        Set oBackup = Nothing
        
        Exit SubErrHandler:
        MsgBox "Error " & Err.Description
        Resume Next
    End SubPrivate Sub cmdRestore_Click()
        On Error GoTo ErrHandler:
        
        Dim oRestore As SQLDMO.Restore
        
        Dim Msg As String
        Dim Response As String'    Msg = "You must choose the right database name according to the data file name selected. Do you want to continue?"
    '    Response = MsgBox(Msg, vbYesNo, gTitle)
    '    If Response = vbNo Then
    '        Exit Sub
    '    End If
            
        gDatabaseName = cmbDatabaseName.Text
        Set oRestore = New SQLDMO.Restore
        Set oRestoreEvent = oRestore        ' enable events
        
        oRestore.Database = gDatabaseName
        gBkupRstrFileName = txtDataFileName.Text
        oRestore.Files = gBkupRstrFileName
        
        ' Change mousepointer while trying to connect.
        Screen.MousePointer = vbHourglass
        
        ' Restore the database.
        oRestore.SQLRestore gSQLServer
        
        ' Change mousepointer back to the default after connect.
        Screen.MousePointer = vbDefault
       
        Set oRestoreEvent = Nothing         ' disable events
        Set oRestore = Nothing
        
        Exit SubErrHandler:
        MsgBox "Error " & Err.Description
        Resume Next
    End SubPrivate Sub cmdBrowse_Click()
        On Error GoTo ErrHandler:
        
        CommonDialog1.CancelError = True
        CommonDialog1.Filter = "All Files (*.*)|*.*|Backup Files (*.bak)|*.bak"
        CommonDialog1.FilterIndex = 2
        CommonDialog1.InitDir = gBkupRstrFilePath
        CommonDialog1.DefaultExt = "bak"
        CommonDialog1.DialogTitle = "Data File Name:"
        CommonDialog1.Action = 1
        txtDataFileName.Text = CommonDialog1.FileName
        Exit Sub
        
    ErrHandler:
        'User pressed the Cancel button
        Exit Sub
    End Sub' VB will create the right prototypes for you, if you select the oBackupEvent in
    ' the drop down listbox of your editor
    Private Sub oBackupEvent_Complete(ByVal Message As String)
        PrintStat "oBackupEvent_Complete -- " & Message
    End SubPrivate Sub oBackupEvent_NextMedia(ByVal Message As String)
        PrintStat "oBackupEvent_NextMedia -- " & Message
    End SubPrivate Sub oBackupEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
        PrintStat "oBackupEvent_PercentComplete -- " & Message & " " & Percent
    End SubPrivate Sub oRestoreEvent_Complete(ByVal Message As String)
        PrintStat "oRestoreEvent_Complete -- " & Message
    End SubPrivate Sub oRestoreEvent_NextMedia(ByVal Message As String)
        PrintStat "oRestoreEvent_NextMedia -- " & Message
    End SubPrivate Sub oRestoreEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
        PrintStat "oRestoreEvent_PercentComplete -- " & Message & " " & Percent
    End SubPrivate Sub PrintStat(ByRef Message As String)
        txtStatus.Text = txtStatus.Text + Message + vbCrLf
    End Sub
      

  5.   


    Private Sub optSSAuth_Click()
        If optSSAuth.Value = True Then
            SSAuthOptionsOn
        End If
    End SubPrivate Sub optWinNTAuth_Click()
        optWinNTAuth.Value = True
        WinNTAuthOptionsOn
        txtUserName.Text = ""
        txtPassword.Text = ""
    End SubPrivate Sub buttonsConnectClosed()
        cmdConnect.Default = True
        
        cmdConnect.Enabled = True
        cmdBackup.Enabled = False
        cmdRestore.Enabled = False
        cmdDisconnect.Enabled = False
        
        cmdBrowse.Enabled = False
        cmbDatabaseName.Enabled = False
        txtDataFileName.Enabled = False
        
        ' Enable the Authorization stuff.
        optWinNTAuth.Enabled = True
        optSSAuth.Enabled = True
        txtServerName.Enabled = True
        lblServer.Enabled = True
        If optWinNTAuth = True Then
            WinNTAuthOptionsOn
        Else
            SSAuthOptionsOn
        End If
    End SubPrivate Sub buttonsConnectOpen()
        cmdConnect.Enabled = False
        cmdBackup.Enabled = True
        cmdRestore.Enabled = True
        cmdDisconnect.Enabled = True
        
        cmdBrowse.Enabled = True
        cmbDatabaseName.Enabled = True
        txtDataFileName.Enabled = True
        
        ' Disable the Authorization stuff.
        optWinNTAuth.Enabled = False
        optSSAuth.Enabled = False
        txtServerName.Enabled = False
        lblServer.Enabled = False
        lblUserName.Enabled = False
        lblPassword.Enabled = False
        txtUserName.Enabled = False
        txtPassword.Enabled = False
    End SubPrivate Sub WinNTAuthOptionsOn()
        lblUserName.Enabled = False
        lblPassword.Enabled = False
        txtUserName.Enabled = False
        txtPassword.Enabled = False
    End SubPrivate Sub SSAuthOptionsOn()
        lblUserName.Enabled = True
        lblPassword.Enabled = True
        txtUserName.Enabled = True
        txtPassword.Enabled = True
    End SubPrivate Sub FillDatabaseList()
        cmbDatabaseName.Clear
        
        ' Enumerate all of the databases and add the names to the list box.
        Dim oDB As SQLDMO.Database
        For Each oDB In gSQLServer.Databases
            If oDB.SystemObject = False Then
                cmbDatabaseName.AddItem oDB.Name
            End If
        Next oDB
        
        ' Take care of the assignment of gBkupRstrFilePath.
        Dim MyPos As Integer
        gBkupRstrFilePath = CurDir
        MyPos = InStr(1, CurDir, "DevTools", 1)
        If MyPos > 0 Then
            gBkupRstrFilePath = Left(gBkupRstrFilePath, MyPos - 1)
            If Len(Dir(gBkupRstrFilePath + "backup", vbDirectory)) Then
                gBkupRstrFilePath = gBkupRstrFilePath + "backup\"
            Else
                gBkupRstrFilePath = "c:\"
            End If
        Else
            gBkupRstrFilePath = "c:\"
        End If
        
        ' Select the first database in the list.
        If cmbDatabaseName.ListCount > 0 Then
            cmbDatabaseName.ListIndex = 0
            ' Assign the default backup/restore file name.
            If Len(cmbDatabaseName.Text) > 0 Then
                txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
            End If
        End If
        
    End Sub
    Private Sub cmbDatabaseName_Click()
        ' Assign the default backup/restore file name.
        If Len(cmbDatabaseName.Text) > 0 Then
            txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
        End If
    End Sub