frmmain.frm

ado对数据库的表进行查询、删除等管理操作。

    Exit Sub
e_Trap:
    lblStatus.caption = "Error: " & Err.Description & " (" & Err.Number & ")"
    imgLoading.Visible = False
End Sub


Private Sub Form_Load()
Dim commandLine As String
Dim serverType As Integer
Dim serverName As String
Dim databaseName As String
Dim Password As String
Dim UserName As String
Dim defaultTable As String
Dim registryString As String
    
    Call Hook(Me.hwnd, 7000, 3500)
    
    Set dbObj = New ADODB.Connection
        
    mnuEdit.Enabled = False
    lblDatabaseName.caption = ""
    
    Me.Width = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Width", WorkAreaWidth, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    Me.Height = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Height", WorkAreaHeight / 2, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    
    Me.Top = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Top", WorkAreaBottom - Me.Height, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    If Me.Top < WorkAreaTop Then
        Me.Top = WorkAreaTop
    ElseIf Me.Top > WorkAreaBottom - Me.Height Then
        Me.Top = WorkAreaBottom - Me.Height
    End If
    If Me.Height > WorkAreaHeight Then
        Me.Height = WorkAreaHeight
    End If
    
    Me.Left = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Left", WorkAreaLeft, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    If Me.Left < WorkAreaLeft Then
        Me.Left = WorkAreaLeft
    ElseIf Me.Left > WorkAreaRight - Me.Width Then
        Me.Left = WorkAreaRight - Me.Width
    End If
    If Me.Width > WorkAreaWidth Then
        Me.Width = WorkAreaWidth
    End If
    
    Me.WindowState = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "WindowState", vbNormal, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    
    mnuShowSQL.Checked = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Show SQL", True, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    Call Form_Resize
    
    On Error Resume Next
    Call AssociateFileType("mdb", False, App.Title)

    LastOpenedType = GetSetting(App.Title, DEF_REGISTRY_SETTINGS, "Last Opened Type", 0, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")

    commandLine = Command
    If commandLine <> "" Then
        If Dir(commandLine) <> "" Then
            dbPath = commandLine
            dbConnectionString = BuildConnectString(e_databaseTypes_MicrosoftAccess2KFile, dbPath)
            dbType = e_databaseTypes_AccessFile
            defaultTable = ""
            If LastOpenedType = e_LastOpened_Access Then
                If dbPath = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\Access", "Database Path", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database") Then
                    defaultTable = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\Access", "Default Table", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
                End If
            End If
            LastOpenedType = e_LastOpened_Access
            Call SaveSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\Access", "Database Path", dbPath, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            Call SetupDatabase(defaultTable, True)
        End If
    Else
        If LastOpenedType = e_LastOpened_Access Then
            dbType = e_databaseTypes_AccessFile
            dbPath = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\Access", "Database Path", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            If dbPath <> "" Then
                If Dir(dbPath) <> "" Then
                    dbConnectionString = BuildConnectString(e_databaseTypes_MicrosoftAccess2KFile, dbPath)
                    defaultTable = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\Access", "Default Table", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
                    Call SetupDatabase(defaultTable, True)
                End If
            End If
        ElseIf LastOpenedType = e_LastOpened_Network Then
            serverType = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS, "", 0, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            
            If serverType = e_databaseTypes_OracleMSDA Then
                registryString = DEF_REGISTRY_CONNECTIONS & "\" & DEF_ORACLE_CLIENT
            ElseIf serverType = e_databaseTypes_OracleODBC Then
                registryString = DEF_REGISTRY_CONNECTIONS & "\" & DEF_ORACLE_ODBC
            ElseIf serverType = e_databaseTypes_SQLserver Then
                registryString = DEF_REGISTRY_CONNECTIONS & "\" & DEF_SQL_SERVER
            ElseIf serverType = e_databaseTypes_DSNFile Then
                registryString = DEF_REGISTRY_CONNECTIONS & "\" & DEF_DSN_FILE
            End If
            
            serverName = GetSetting(App.Title, registryString, "Server Name", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            databaseName = GetSetting(App.Title, registryString, "Database Name", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            UserName = GetSetting(App.Title, registryString, "Username", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            Password = GetSetting(App.Title, registryString, "Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
            defaultTable = GetSetting(App.Title, registryString, "Default Table", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
             
            
            dbType = serverType
            dbPath = UCase(Mid(serverName, 1, 1)) & LCase(Mid(serverName, 2))
            If Trim(databaseName) <> "" Then
                dbPath = dbPath & " : " & databaseName
            End If
            
            dbConnectionString = BuildConnectString(serverType, serverName, databaseName, UserName, Password)
            Call SetupDatabase(defaultTable, True)
        End If
    End If
    
End Sub
Public Sub SetupDatabase(Optional defaultTable As String, Optional centerScreen As Boolean = False)
    If dbType = e_databaseTypes_AccessFile Or dbType = e_databaseTypes_MicrosoftAccess2KFile Or dbType = e_databaseTypes_MicrosoftAccess97File Then
        frmMain.mnuCompact.Visible = True
    Else
        frmMain.mnuCompact.Visible = False
    End If
    
    lblDatabaseName.caption = BuildDatabaseName(dbType, dbPath, LastOpenedType)
    Call frmConnecting.ShowConnecting("Connecting to " & lblDatabaseName.caption, IIf(centerScreen = False, Me, Nothing))
    Me.caption = App.Title & " (" & lblDatabaseName.caption & ")"
    Call GetTableList(defaultTable, centerScreen)
    frmConnecting.Hide
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim frmObj As Object
    If Me.WindowState <> vbMinimized Then
        Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "WindowState", Me.WindowState, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    End If
    If Me.WindowState = vbNormal Then
        Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Top", Me.Top, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Left", Me.Left, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Width", Me.Width, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Form Height", Me.Height, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    End If
    Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Last Opened Type", CStr(LastOpenedType), HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    Call SaveSetting(App.Title, DEF_REGISTRY_SETTINGS, "Show SQL", CStr(mnuShowSQL.Checked), HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    
    Call SaveDefaultTable
    
    For Each frmObj In Forms
        Unload frmObj
    Next
    
    Set dbObj = Nothing
    Call Unhook
End Sub

Private Sub Form_Resize()

    If mnuShowSQL.Checked = True Then
        fraSqlStatement.Visible = True
    Else
        fraSqlStatement.Visible = False
    End If
    
    If Me.WindowState = vbMinimized Then Exit Sub
    
    'Height
    If mnuShowSQL.Checked = True Then
        gridData.Height = Me.Height - gridData.Top - 2000
    Else
        gridData.Height = Me.Height - gridData.Top - 1050
    End If
    
    'Width
    gridData.Width = Me.Width - 360
    fraSqlStatement.Width = gridData.Width
    txtSqlStatement.Width = fraSqlStatement.Width - txtSqlStatement.Left - cmdExecute.Width - 200
    
    'Top
    imgLoading.Top = Me.Height - 950
    lblStatus.Top = Me.Height - 950
    fraSqlStatement.Top = gridData.Top + gridData.Height + 100
    
    'Left
    imgLoading.Left = gridData.Left + gridData.Width - imgLoading.Width
    chkEditMode.Left = gridData.Left + gridData.Width - chkEditMode.Width
    cmdExecute.Left = txtSqlStatement.Left + txtSqlStatement.Width + 100
    
End Sub

Private Sub GetTableList(Optional ByVal defaultTable As String, Optional ByVal centerScreen As Boolean = False)
Dim rsSchema As ADODB.Recordset
Dim nCount As Integer
Dim newTableName As String
Dim Password As String

    On Error Resume Next
    LockTextBox = True
    frmMain.cmbTables.Clear
    frmPurgeDate.cmbTables.Clear
    frmRenameTable.cmbTables.Clear
    If dbObj.State = adStateOpen Then
        Set dbObj = New ADODB.Connection
    End If
    dbObj.Open dbConnectionString
    If dbObj.State <> adStateOpen And (dbType = e_databaseTypes_AccessFile Or e_databaseTypes_MicrosoftAccess2KFile Or e_databaseTypes_MicrosoftAccess97File) Then
        If centerScreen = True Then
            Password = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        End If
        If Password = "" Then
            frmPassword.caption = DetermineFilename(dbPath) & " Password"
            frmPassword.Show vbModal, IIf(centerScreen = False, Me, Nothing)
            If frmPassword.bWasCancelled = True Then
                Exit Sub
            End If
        End If
        dbConnectionString = dbConnectionString & "PWD=" & frmPassword.txtPassword & ";"
        dbObj.Open dbConnectionString
        Unload frmPassword
        mnuClearPassword.Visible = True
    Else
        mnuClearPassword.Visible = False
        Call SaveSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    End If
    If dbObj.State = adStateOpen Then
        Set rsSchema = dbObj.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE"))
        If Not rsSchema Is Nothing Then
            Do While Not rsSchema.EOF
                If UCase(Left(rsSchema!Table_name, 4)) <> "MSYS" Then
                    If UCase(Left(rsSchema!Table_name, 11)) <> "SWITCHBOARD" Then
                        newTableName = rsSchema!Table_name
                        cmbTables.AddItem newTableName
                        frmPurgeDate.cmbTables.AddItem newTableName
                        frmRenameTable.cmbTables.AddItem newTableName
                    End If
                End If
                rsSchema.MoveNext
            Loop
            cmbTables.AddItem DEF_CUSTOM_SQL
        End If
    End If
    rsSchema.Close
    If cmbTables.ListCount > 0 Then
        If defaultTable = "" Then
            cmbTables.ListIndex = 0
            frmPurgeDate.cmbTables.ListIndex = 0
            frmRenameTable.cmbTables.ListIndex = 0
        Else
            For nCount = 0 To cmbTables.ListCount - 1
                If cmbTables.List(nCount) = defaultTable Then
                    cmbTables.ListIndex = nCount
                    frmPurgeDate.cmbTables.ListIndex = nCount
                    frmRenameTable.cmbTables.ListIndex = nCount
                    Exit For
                End If
            Next nCount
            If cmbTables.ListIndex = -1 Then
                cmbTables.ListIndex = 0
                frmPurgeDate.cmbTables.ListIndex = 0
                frmRenameTable.cmbTables.ListIndex = 0
            End If
        End If
    End If
    
    Set gridData.DataSource = adoData

    Set rsSchema = Nothing
    LockTextBox = False
End Sub

Private Sub chkEditMode_Click()
    mnuEditMode.Checked = IIf(chkEditMode.Value = vbChecked, True, False)
    If chkEditMode.Value = vbChecked Then
        gridData.AllowAddNew = True
        gridData.AllowDelete = True
        gridData.AllowUpdate = True
    Else
        gridData.AllowAddNew = False
        gridData.AllowDelete = False
        gridData.AllowUpdate = False
    End If
    If chkEditMode.Value = vbChecked And cmbTables.Text <> DEF_CUSTOM_SQL Then
        mnuEdit.Enabled = True
    Else
        mnuEdit.Enabled = False
    End If
    
End Sub

Private Sub cmbTables_Change()
    Call cmbTables_Click
End Sub

Private Sub cmbTables_Click()
    Call LoadData
End Sub
Public Sub LoadData()
    
    On Error GoTo e_Trap
    Call chkEditMode_Click
    If cmbTables.Text = DEF_CUSTOM_SQL Then
        mnuShowSQL.Checked = True
        Call Form_Resize
        On Error Resume Next
        If LockTextBox = False Then
            txtSqlStatement.SetFocus
            txtSqlStatement.SelStart = 0
            txtSqlStatement.SelLength = Len(txtSqlStatement)
        End If
        Exit Sub
    End If
    
    LockTextBox = True
    If cmbTables.Text = "" Then Exit Sub