dbchecker.frm

数据库自动安装,为学员深入了解数据库编程语言提供方便。

        tb.MoveNext
    Loop

Exit Sub

ERRORINDELETEpRIMARYkEY:
    Resume Next

End Sub

Private Sub Form_Load()

    Screen.MousePointer = vbHourglass
    DoEvents
'    BrowseBtn_Click
    Text2 = "(local)"
    If GetDiskInfo("c:\") > 3145728 Then
        DbDrive = "C"
      ElseIf GetDiskInfo("D:\") > 3145728 Then
        DbDrive = "D"
    End If

    Text2_LostFocus
'    DbList.AddItem "AutoCID"
'    Command2_Click
    
    Screen.MousePointer = vbNormal

End Sub

Private Function GetDiskInfo(DriveLetter As String) As Currency

  '

  Dim r As Long
  Dim BytesFreeToCalller As Currency
  Dim TotalBytes As Currency
  Dim TotalFreeBytes As Currency
  Dim TotalBytesUsed As Currency
  Dim TNB As Double
  Dim TFB As Double
  Dim FreeBytes As Long

  Dim DLetter As String
  Dim spaceInt As Integer

    On Error GoTo GetDiskInfo_Error
    spaceInt = InStr(DriveLetter, " ")
    If spaceInt > 0 Then
        DriveLetter = Left$(DriveLetter, spaceInt - 1)
    End If
    If Right$(DriveLetter, 1) <> "\" Then
        DriveLetter = DriveLetter & "\"
    End If
    DLetter = Left$(UCase$(DriveLetter), 1)
    Call GetDiskFreeSpaceEx(DriveLetter, BytesFreeToCalller, TotalBytes, TotalFreeBytes)
    GetDiskInfo = BytesFreeToCalller * 10000
    On Error GoTo 0
Exit Function
GetDiskInfo_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetDiskInfo of Form Form1"
End Function

Private Sub NameCheck()

  Dim TextLine As String
  Dim tmp As String
  Dim cn As New rdoConnection
  Dim cpw As rdoQuery
  Dim tb As rdoResultset
  Dim TbSet As rdoTable
  Dim coltb As rdoColumn
  Dim TempCol As rdoColumn
  Dim cn1 As New rdoConnection
  Dim TempTable As rdoTable
  Dim i As Integer
  Dim j As Integer
  Dim a As Integer
  Dim Till As Integer
  Dim found As Boolean
  Dim AnyError As Boolean
  Dim errorstring As String
  Dim ColFound As Boolean
  Dim inderrorstring As String
  Dim dbs As Integer
  Dim SummaryErr As String
  Dim DetailErr As String
  '-------------------------

    ProgressBar1.Value = 0
    Screen.MousePointer = 11
    If Trim$(Text1) = "" Then
        MsgBox "Enter The Script Location!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If Trim$(Text2) = "" Then
        MsgBox "Enter the name of the server!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If DbList.ListCount = 0 Then
        MsgBox "Enter The name(s) Of The Database(s) You Want Checked!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If Len(DbDrive) = 0 Then
        MsgBox "Enter The Drive of The Temporary Database!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If Dir(Trim$(Text1)) = "" Then
        MsgBox "Script Not Found!", vbCritical
        Exit Sub
    End If
    passedTesting = True
    Close #1
    Open Trim(Text1) For Input As #1

    cn.Connect = "uid=sa;pwd=" & PassToPass & ";server=" & Text2 & ";driver={SQL Server};database=" & DbList.List(0) & ";DSN='';"
    cn.CursorDriver = rdUseOdbc
    cn.EstablishConnection rdDriverNoPrompt

    tmp = "USE master" & Chr$(13) & Chr$(10)
    tmp = tmp & "select * from sysdatabases where name = 'TempStruc'"
    Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
    If tb.EOF And tb.BOF Then
        If Dir(Trim$(DbDrive) & ":\TempStruc.mdf") <> "" Then
            Kill Trim$(DbDrive) & ":\TempStruc.mdf"
        End If
        If Dir(Trim$(DbDrive) & ":\TempStruclogs.ldf") <> "" Then
            Kill Trim$(DbDrive) & ":\TempStruclogs.ldf"
        End If
      Else
        tmp = "USE master" & Chr$(13) & Chr$(10)
        tmp = "if exists (select * from sysdatabases where name = 'TempStruc') drop DATABASE TempStruc" & Chr$(13) & Chr$(10)
        Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
    End If
    DoEvents
    tmp = "USE master" & Chr$(13) & Chr$(10)
    tmp = tmp & "CREATE DATABASE TempStruc" & Chr$(13) & Chr$(10)
    tmp = tmp & "ON ( NAME = TempStruc_dat, FILENAME = '" & Trim$(DbDrive) & ":\TempStruc.mdf',SIZE = 10,MAXSIZE = 50,FILEGROWTH = 5)"
    tmp = tmp & "LOG ON ( NAME = 'TempStruc_log', FILENAME = '" & Trim$(DbDrive) & ":\TempStruclogs.ldf',SIZE = 5MB, MAXSIZE = 25MB,  FILEGROWTH = 5MB )"

    Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
    cn.Close
    cn.Connect = "uid=sa;pwd=" & PassToPass & ";server=" & Text2 & ";driver={SQL Server};database=TempStruc;DSN='';"
    cn.CursorDriver = rdUseOdbc
    cn.EstablishConnection rdDriverNoPrompt

    tmp = ""
    Do While Not EOF(1)
        Line Input #1, TextLine
        If Len(TextLine) > 1 Then
            If (Left$(UCase$(TextLine), 2)) <> "GO" Then
                tmp = tmp & Chr$(13) & Chr$(10) & TextLine

              Else
                On Error Resume Next
                    Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
                    tmp = ""
                End If
              Else
                tmp = tmp & Chr$(13) & Chr$(10) & TextLine
            End If
        Loop
        DoEvents
    On Error GoTo 0
    tb.Close
    '-------------'
    Close #1
    For dbs = 0 To DbList.ListCount - 1
        ProgressBar1.Value = 0
        ProgressBar1.Max = cn.rdoTables.Count
        DoEvents
        cn1.Connect = "uid=sa;pwd=" & PassToPass & ";server=" & Text2 & ";driver={SQL Server};database=" & DbList.List(dbs) & ";DSN='';"
        cn1.CursorDriver = rdUseOdbc
        cn1.EstablishConnection rdDriverNoPrompt
        cn1.QueryTimeout = 3000
        cn1.rdoTables.Refresh
        found = False

        For Each TbSet In cn.rdoTables
            Set cpw = cn.CreateQuery("", "EXEC sp_tables " & TbSet.Name)
            Set tb = cpw.OpenResultset(2)
            If UCase$(TbSet.Type) = "TABLE" And UCase$(tb!table_type) = "TABLE" Then
                For Each TempTable In cn1.rdoTables
                    errorstring = ""
                    DetailErr = ""
                    SummaryErr = ""
                    If UCase$(TempTable.Type) = "TABLE" Then
                        If UCase$(TbSet.Name) = UCase$(TempTable.Name) Then
                            found = True
                            For i = 0 To TbSet.rdoColumns.Count - 1
                                ColFound = False
                                For j = 0 To TempTable.rdoColumns.Count - 1
                                    DoEvents
                                    If UCase$(TbSet.rdoColumns(i).Name) = UCase$(TempTable.rdoColumns(j).Name) Then  ''Name Comparison
                                        ColFound = True
                                        DoEvents
                                        If TbSet.rdoColumns(i).Type <> TempTable.rdoColumns(j).Type Then
                                            DetailErr = DetailErr & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Type Mismatch"
                                            DoEvents
                                          Else
                                            If TbSet.rdoColumns(i).Size <> TempTable.rdoColumns(j).Size Then
                                                DetailErr = DetailErr & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Size Mismatch"
                                                DoEvents
                                              Else
                                                If TbSet.rdoColumns(i).Required <> TempTable.rdoColumns(j).Required Then
                                                    DetailErr = DetailErr & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Null"
                                                    DoEvents
                                                  Else
                                                    If Defaults = 1 Then
                                                        CheckDefaults cn, cn1, TbSet.Name, TbSet.rdoColumns(i).Name, errorstring
                                                        DoEvents
                                                    End If
                                                End If
                                            End If
                                        End If
                                        Exit For
                                    End If
                                Next j
                                If ColFound = False Then
                                    AddingOneColumn cn, cn1, TbSet, TempTable, errorstring, TbSet.rdoColumns(i).Name
                                    DoEvents
                                End If
                            Next i
                            If errorstring <> "" Then
                                Text4 = TempTable.Name & errorstring & Chr$(13) & Chr$(10) & Text4
                            End If
                            Exit For
                        End If
                    End If
                Next TempTable
            End If
            If found = False And UCase$(tb!table_type) = "TABLE" Then
                tmp = "cn.CreateQuery "
                AddTable cn, cn1, TbSet, TempTable
                Text4 = "<<< " & TbSet.Name & " Added To Original Database >>>" & Chr$(13) & Chr$(10) & Text4
            End If
            found = False
            '--------
            inderrorstring = ""
            checkingIndexes cn, cn1, TbSet, TempTable, inderrorstring, errorstring
            If inderrorstring <> "" Then
                Text4 = inderrorstring & Chr$(13) & Chr$(10) & Text4
            End If
            '----------------------------------'
            ProgressBar1.Value = ProgressBar1.Value + 1
            DoEvents
            tb.Close
        Next TbSet
        If TriggerCheck = 1 Then
            Triggers cn1, errorstring
            Text4 = errorstring & Chr$(13) & Chr$(10) & Text4
        End If
        If StoredProc = 1 Then
            StoredProcedures cn1, errorstring
            Text4 = errorstring & Chr$(13) & Chr$(10) & Text4
        End If
        Text4 = "  再次检查校验安装过程是SQL Server数据库： " & DbList.List(dbs) & Chr$(13) & Chr$(10) & Text4
        DoEvents
        cn1.Close
    Next dbs
    Screen.MousePointer = 0

End Sub

Private Sub PositionCheck()

  Dim TextLine As String
  Dim tmp As String
  Dim cn As New rdoConnection
  Dim cpw As rdoQuery
  Dim tb As rdoResultset
  Dim cn1 As New rdoConnection
  Dim TbSet As rdoTable
  Dim TempTable As rdoTable
  Dim coltb As rdoColumn
  Dim TempCol As rdoColumn
  Dim i As Integer
  Dim a As Integer
  Dim Till As Integer
  Dim found As Boolean
  Dim AnyError As Boolean
  Dim errorstring As String
  '-------------------------

    ProgressBar1.Value = 0
    Screen.MousePointer = 11
    If Trim$(Text1) = "" Then
        MsgBox "Enter The Script Location!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If Trim$(Text2) = "" Then
        MsgBox "Enter the name of the server!", vbInformation, "Structure Check"
        Exit Sub
    End If
    If DbList.ListCount = 0 Then
        MsgBox "Enter the name of the Database on the Server!", vbInformation, "Structure Check"
        Exit Sub
    End If

    Open Trim(Text1) For Input As #1

    cn.CursorDriver = rdUseOdbc
    cn.EstablishConnection rdDriverNoPrompt
    tmp = "USE master" & Chr$(13) & Chr$(10)
    tmp = tmp & "if exists (select * from sysdatabases where name = 'TempStruc') drop DATABASE TempStruc" & Chr$(13) & Chr$(10)
    tmp = tmp & "CREATE DATABASE TempStruc" & Chr$(13) & Chr$(10)
    tmp = tmp & "ON ( NAME = TempStruc_dat, FILENAME = 'd:\TempStruc.mdf',SIZE = 10,MAXSIZE = 50,FILEGROWTH = 5)"
    tmp = tmp & "LOG ON ( NAME = 'TempStruc_log', FILENAME = 'd:\TempStruclogs.ldf',SIZE = 5MB, MAXSIZE = 25MB,  FILEGROWTH = 5MB )"
    Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
    cn.Close
    cn.Connect = "uid=sa;pwd=;server=" & Text2 & ";driver={SQL Server};database=TempStruc;DSN='';"
    cn.CursorDriver = rdUseOdbc
    cn.EstablishConnection rdDriverNoPrompt

    tmp = ""
    Do While Not EOF(1)
        Line Input #1, TextLine
        If Len(TextLine) > 1 Then
            If (Left$(UCase$(TextLine), 2)) <> "GO" Then
                tmp = tmp & Chr$(13) & Chr$(10) & TextLine

              Else
                Set tb = cn.OpenResultset(tmp, 2, rdConcurRowVer)
                tmp = ""
            End If
          Else
            tmp = tmp & Chr$(13) & Chr$(10) & TextLine
        End If
    Loop

    tb.Close
    '-------------'
    Close #1
    cn1.CursorDriver = rdUseOdbc
    cn1.EstablishConnection rdDriverNoPrompt
    ProgressBar1.Max = cn.rdoTables.Count
    For Each TbSet In cn.rdoTables
        Set cpw = cn.CreateQuery("", "EXEC sp_tables " & TbSet.Name & "")
        Set tb = cpw.OpenResultset(2)
        If UCase$(TbSet.Type) = "TABLE" And UCase$(tb!table_type) = "TABLE" Then
            For Each TempTable In cn1.rdoTables
                errorstring = ""
                If UCase$(TempTable.Type) = "TABLE" Then
                    If UCase$(TbSet.Name) = UCase$(TempTable.Name) Then
                        found = True
                        If TbSet.rdoColumns.Count > TempTable.rdoColumns.Count Then
                            Till = TempTable.rdoColumns.Count - 1
                            a = TbSet.rdoColumns.Count - TempTable.rdoColumns.Count
                            AddingColumns cn, cn1, TbSet, TempTable, a, errorstring
                          Else
                            Till = TbSet.rdoColumns.Count - 1
                        End If
                        For i = 0 To Till
                            If UCase$(TbSet.rdoColumns(i).Name) <> UCase$(TempTable.rdoColumns(i).Name) Then  ''Name Comparison
                                errorstring = errorstring & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & ": Not Found"
                              Else
                                If TbSet.rdoColumns(i).Type <> TempTable.rdoColumns(i).Type Then
                                    errorstring = errorstring & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Type Mistmatch"
                                  Else
                                    If TbSet.rdoColumns(i).Size <> TempTable.rdoColumns(i).Size Then
                                        errorstring = errorstring & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Size Mistmatch"
                                      Else
                                        If TbSet.rdoColumns(i).Required <> TempTable.rdoColumns(i).Required Then
                                            errorstring = errorstring & Chr$(13) & Chr$(10) & Chr$(9) & TbSet.rdoColumns(i).Name & " : Null"
                                        End If
                                    End If
                                End If
                            End If
                        Next i
                        Exit For
                    End If
                End If
            Next TempTable
        End If
        If found = False And UCase$(tb!table_type) = "TABLE" Then
            tmp = "cn.CreateQuery "
            AddTable cn, cn1, TbSet, TempTable
        End If
        found = False
        ProgressBar1.Value = ProgressBar1.Value + 1
        tb.Close
    Next TbSet
    Screen.MousePointer = 0

End Sub

Private Sub QuickDbCheck_Click()

    If QuickDbCheck.Value = 1 Then
        Frame1.Enabled = False
        Defaults.Enabled = False
        StoredProc.Enabled = False
        TriggerCheck.Enabled = False
        Defaults.Value = 0
        StoredProc.Value = 1