frmmain.frm

以前做项目时

         Left            =   900
         TabIndex        =   1
         Top             =   270
         Width           =   2055
      End
      Begin VB.Label Label1 
         Caption         =   "服务器"
         Height          =   180
         Left            =   210
         TabIndex        =   7
         Top             =   300
         Width           =   540
      End
      Begin VB.Label Label2 
         Caption         =   "用户名"
         Height          =   180
         Left            =   210
         TabIndex        =   6
         Top             =   720
         Width           =   540
      End
      Begin VB.Label Label3 
         Caption         =   "密码"
         Height          =   180
         Left            =   390
         TabIndex        =   5
         Top             =   1110
         Width           =   360
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'发布日期：06/04/19
'描    述：
'网    站：
'e-mail  ：[e-mail]
'OICQ    ：[e-mail]
'作    者: 李绍龙
'****************************************************************************

Dim vRst As New ADODB.Recordset
Dim strConn As String
Dim ImpFileName As String
Dim ImpFilePath As String

Private Sub Command1_Click()

''至于列印所有数据库,肯定要先 Login
''然后再用 SQLDMO 所含数据库:
'
On Error GoTo ErrorInfo
Dim SQLServerX As New SQLServer
    aniSvr.Open App.Path & "\findfile.avi"
    aniSvr.Play
    SQLServerX.Connect Combo1.Text, Text2.Text, Text3.Text
    Dim i As Long
    For i = 0 To SQLServerX.Databases.Count - 1
        Combo3.AddItem SQLServerX.Databases.Item(i + 1).Name
    Next i
    aniSvr.Stop
    Exit Sub
ErrorInfo:
    aniSvr.Stop
    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
End Sub

Private Sub Command12_Click()
'清空日志
strSql = "DUMP TRANSACTION 库名 WITH NO_LOG"
'截断事务日志
strSql = "BANKUP LOG 数据库名 WITH NO_LOG"
End Sub

Private Sub Command2_Click()
    Dialog.Filter = "文本文件|*.TXT"
    Dialog.ShowOpen
    If Dialog.FileName <> "" Then
'        edtImpFile.Text = Dialog.FileName
        ImpFileName = Dialog.FileName
'        ImpFilePath = GetFilePath(ImpFileName)
            Call OpenTxtFile(ImpFileName)
    End If
End Sub

Private Sub OpenTxtFile(File_Name As String)
Dim strRow As String
Dim blnSFDJ As Boolean
Dim blnDWDM As Boolean
Dim blnXMDM As Boolean
Dim bDWDM As String
Dim IFRepeatDWDM As String
Dim i As Integer

On Error GoTo ErrorInfo
        Text1.Text = "" '.Clear
        blnImp = True
        Open File_Name For Input As #1
        Do Until EOF(1)
            Line Input #1, strRow
                If Text1.Text = "" Then
                    Text1.Text = strRow
                Else
                    Text1.Text = Text1.Text + vbCrLf + strRow
                End If
        Loop
        Close #1
        Exit Sub
ErrorInfo:
    MsgBox "加载文件失败!", vbOKOnly + vbExclamation, "提示"
End Sub

Private Sub Command3_Click()
On Error GoTo ErrorInfo
    cn.Execute Text1.Text
    MsgBox "执行成功!", vbOKOnly + vbExclamation, "提示"
    
    Exit Sub
ErrorInfo:
    MsgBox "执行失败,请检查数据库连接!", vbOKOnly, "提示"
End Sub

Private Sub Command4_Click()


On Error GoTo ErrorInfo
    aniDB.Open App.Path & "\findfile.avi"
    aniDB.Play
    strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
            " User ID=" & Trim(Text5.Text) & ";PassWord=" & Trim(Text4.Text) & ";Initial Catalog=" & Trim(Combo3.Text) & ";Data Source=" & Combo1.Text & ";"
    If cnn.State = 1 Then cnn.Close
    cnn.Open strConn
'
    Dim adoxCatalogX As New ADOX.Catalog
    Set adoxCatalogX.ActiveConnection = cnn
    Dim i As Integer
    Dim j As Integer
    For i = 0 To adoxCatalogX.Tables.Count - 1
        If adoxCatalogX.Tables.Item(i).Type = "TABLE" Then
          Combo2.AddItem adoxCatalogX.Tables.Item(i).Name
        End If
    Next
    aniDB.Stop
    Exit Sub
ErrorInfo:
    aniDB.Stop
    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
End Sub

Private Sub Command5_Click()
    Unload Me

End Sub

Private Sub Command6_Click()
Dim strSql As String
Dim vRst As New ADODB.Recordset

    '分离
    strSql = "EXEC sp_detach_db @dbname='" & Combo3.Text & "'"
    vRst.Open strSql, cnn, adOpenKeyset, adLockReadOnly
    strSql = "删除日志文件"
    '再附加
    strSql = "EXEC sp_attach_single_file_db @dbname='',@physname='c:\Program Files\Microsoft SQL Server\MssQL\Data\.mdf'"
    '为了以后能自动收缩
    strSql = "EXEC sp_dboption '数据库名','autoshrink','true'"
    '如果想以后不让它日志增长的太大--将文件增长限制为xM（x是你允许的最大数据文件大小）
    strSql = "alter database 数据库名 modify file(name=逻辑文件名,maxsize=20)"

End Sub

Private Sub Command7_Click()
Dim strSql As String
Dim vRst As New ADODB.Recordset

    strSql = "backup database xf_database to Disk='filename'"
End Sub

Private Sub Command8_Click()
Dim strSql As String
Dim vRst As New ADODB.Recordset

    strSql = "database databasename from disk='FileName'"
End Sub

Private Sub Command9_Click()
Dim StrBackName As String

        Dialog.Filter = "备份文件|*.BAK"
    Dialog.ShowSave
    If Dialog.FileName <> "" Then
        StrBackName = Dialog.FileName
    End If
        Call BackupDatabase(StrBackName)
End Sub

Private Sub Form_Load()
aniDB.Open App.Path & "\findfile.avi"
aniSvr.Open App.Path & "\findfile.avi"
'Dim i As Integer
'Dim SQLDMOAppX As New SQLDMO.Application
'Dim NameListX As SQLDMO.NameList
'Set NameListX = SQLDMOAppX.ListAvailableSQLServers
'For i = 0 To NameListX.Count - 1
'    Combo1.AddItem NameListX.Item(i + 1)
'Next
End Sub


'* 名称：BackupDatabase
'* 功能：备份数据库
'* 控件：一个文本框和两个按钮（备份到和确定）
'*********************************************************
Public Sub BackupDatabase(StrBackName As String)
Dim strSql As String
Dim vRst As New ADODB.Recordset
Dim strTable As String
Dim iFieldCount As Integer
Dim iRecord As Integer
Dim strField As String
Dim strFieldValue As String

    On Error GoTo ErrorInfo
    
'    Select Case Combo1.Text
'        Case "机主信息表"
'            strTable = "TelBaseManage"
'        Case "话单通讯信息表"
'            strTable = "TelBillManage"
'        Case "TelFieldMatching"
'
'        Case "基站通讯信息表"
'            strTable = "StationBillManage"
'        Case "基站维护表"
'            strTable = "StationManage"
'        Case "案件维护表"
'            strTable = "CaseManage"
'        Case "用户信息表"
'            strTable = "AccountMangae"
'
'    End Select
        strTable = Combo2.Text
    strSql = "select * from " & strTable
    If vRst.State = 1 Then
    vRst.Close
    End If
    vRst.Open strSql, cnn, adOpenKeyset, adLockReadOnly
    '取表的字段
    strField = ""
    For iFieldCount = 1 To vRst.Fields.Count - 1
        strField = strField & vRst.Fields(iFieldCount).Name & ","
'        strFieldValue = strFieldValue & "'" & vRst.Fields(iFieldCount).Value & "',"
    Next
    If vRst.RecordCount > 0 Then
    Me.Hide
'    frm_Bar.Show
'    frm_Bar.Bar.Max = vRst.RecordCount + 1
        Open StrBackName For Output As #1
        Print #1, "delete from " & strTable
        For iRecord = 0 To vRst.RecordCount - 1
'            frm_Bar.Bar.Value = iRecord + 1
            DoEvents
            strFieldValue = ""
            For iFieldCount = 1 To vRst.Fields.Count - 1
                    strFieldValue = strFieldValue & "'" & vRst.Fields(iFieldCount).Value & "',"
            Next
            Print #1, "insert into " & strTable & " (" & Mid(strField, 1, Len(strField) - 1) & ") values(" & _
                            Mid(strFieldValue, 1, Len(strFieldValue) - 1) & ")"
        Next
        Close #1
'    Unload frm_Bar
    MsgBox "数据备份成功!", vbOKOnly + vbExclamation, "提示"
    
    Me.Show
    End If
    Exit Sub
ErrorInfo:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
End Sub