frmmain.frm

vb 访问数据库源代码 哈哈哈还少？奶奶的

        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
    imgLoading.Visible = True
    Me.Refresh
    SortOrder = True
    LastColumnSort = 0
    Set gridData.DataSource = Nothing
    adoData.RecordSource = ""
    adoData.ConnectionString = ""
    adoData.ConnectionString = dbConnectionString
    adoData.RecordSource = "SELECT * FROM " & ResolveTable(cmbTables.Text)
    adoData.Refresh
    txtSqlStatement = adoData.RecordSource
    If adoData.Recordset.Fields.Count = 0 Then
        gridData.ClearFields
    Else
        Set gridData.DataSource = adoData.Recordset
        gridData.ClearFields
        gridData.ReBind
    End If
    lblStatus.caption = "Record Count: " & adoData.Recordset.RecordCount
    imgLoading.Visible = False
    LockTextBox = False
    Exit Sub
e_Trap:
    lblStatus.caption = "Error: " & Err.Description & " (" & Err.Number & ")"
    imgLoading.Visible = False
    LockTextBox = False

End Sub

Private Sub gridData_HeadClick(ByVal ColIndex As Integer)
Dim startingSql As String
Dim lastSql As String

    On Error GoTo e_Trap
    LockTextBox = True
    imgLoading.Visible = True
    Me.Refresh
    Call LockWindow(gridData.hwnd)
    If LastColumnSort = ColIndex Then
        SortOrder = Not SortOrder
    Else
        SortOrder = True
    End If
    lastSql = adoData.RecordSource
    If cmbTables.Text = DEF_CUSTOM_SQL Then
        If InStr(1, UCase(txtSqlStatement), "ORDER BY") <> 0 Then
            startingSql = Mid(txtSqlStatement, 1, InStr(1, UCase(txtSqlStatement), "ORDER BY") - 2)
            adoData.RecordSource = startingSql & " ORDER BY " & ResolveTable(adoData.Recordset.Fields(ColIndex).Name) & " " & IIf(SortOrder, "ASC", "DESC")
        Else
            adoData.RecordSource = txtSqlStatement & " ORDER BY " & ResolveTable(adoData.Recordset.Fields(ColIndex).Name) & " " & IIf(SortOrder, "ASC", "DESC")
        End If
    Else
        adoData.RecordSource = "SELECT * FROM " & ResolveTable(cmbTables.Text) & " ORDER BY " & ResolveTable(adoData.Recordset.Fields(ColIndex).Name) & " " & IIf(SortOrder, "ASC", "DESC")
    End If
    LastColumnSort = ColIndex
    txtSqlStatement = adoData.RecordSource
    adoData.Refresh
    Set gridData.DataSource = adoData
    cmbTables.SetFocus
    Call ReleaseWindow
    imgLoading.Visible = False
    LockTextBox = False
    Exit Sub
e_Trap:
    lblStatus.caption = "Order Error: " & Err.Description & " (" & Err.Number & ")"
    If adoData.Recordset Is Nothing And lastSql <> "" Then
        adoData.RecordSource = lastSql
        adoData.Refresh
    End If
    Call ReleaseWindow
    LockTextBox = False
End Sub



Private Sub mnuAddColumn_Click()
    frmAddColumn.sTableName = ResolveTable(cmbTables.Text)
    frmAddColumn.Show vbModal, Me
End Sub

Private Sub mnuAddTable_Click()
    frmAddTable.Show vbModal, Me
End Sub

Private Sub mnuClearPassword_Click()
    mnuClearPassword.Visible = False
    Call SaveSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
End Sub

Private Sub mnuDeleteColumn_Click()
Dim ret As Integer
    On Error GoTo e_Trap
    If gridData.Row <= 0 And gridData.SelStartCol <> -1 And adoData.Recordset.Fields.Count > 1 Then
        ret = MessageBox(Me.hwnd, "Are you sure you want to delete " & adoData.Recordset.Fields(gridData.SelStartCol).Name & " from " & cmbTables.Text & "?", vbYesNo + vbQuestion, "Delete Column")
        If ret = vbYes Then
            Call dbObj.Execute("ALTER TABLE " & ResolveTable(cmbTables.Text) & " DROP COLUMN [" & adoData.Recordset.Fields(gridData.SelStartCol).Name & "]")
            Call SetupDatabase(cmbTables.Text)
        End If
    End If
e_Trap:
    Exit Sub
End Sub

Private Sub mnuDropTable_Click()
Dim ret As Integer
    If cmbTables.Text = DEF_CUSTOM_SQL Then
        Exit Sub
    End If
    ret = MessageBox(Me.hwnd, "Are you sure you want to drop Table: " & cmbTables.Text & "?", vbYesNo + vbQuestion, "Drop Table")
    If ret = vbYes Then
        Call dbObj.Execute("DROP TABLE " & ResolveTable(cmbTables.Text))
        Call GetTableList
    End If
End Sub

Private Sub mnuEditMode_Click()
    chkEditMode.Value = IIf(chkEditMode.Value = vbChecked, vbUnchecked, vbChecked)
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Function SelectFile(Title As String, filter As String, flags As Long, defaultExtension As String, Optional saveFile As Boolean = True, Optional lastFilename As String) As String
Dim sOpen As SelectedFile
Dim filename As String
Dim ret As Integer

    On Error GoTo e_Browse
    FileDialog.sFilter = filter
    FileDialog.flags = flags
    FileDialog.sDlgTitle = Title
    FileDialog.sInitDir = DetermineDirectory(lastFilename)
    FileDialog.sFile = DetermineFilename(lastFilename)
    
    Do While filename = ""
        If saveFile = False Then
            sOpen = ShowOpen(Me.hwnd, True)
        Else
            sOpen = ShowSave(Me.hwnd, True)
        End If
        If sOpen.sFiles(1) = "" Then
            ret = MessageBox(Me.hwnd, "Please select a " & Title, vbOKCancel + vbInformation, "Missing Filename")
            If ret = vbCancel Then
                Exit Function
            End If
        Else
            filename = sOpen.sLastDirectory & sOpen.sFiles(1)
            If InStr(1, filename, ".") = 0 Then
                If LCase(Right(filename, 4)) <> "." & defaultExtension Then
                    filename = filename & "." & defaultExtension
                End If
            End If
            SelectFile = filename
        End If
    Loop
    Exit Function
e_Browse:
    SelectFile = ""
    Exit Function
End Function


Private Sub mnuOpenAccess_Click()
Dim openFile As String
Dim lastFile As String
    On Error GoTo e_Trap
    Call SaveDefaultTable
    
    lastFile = GetSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Path", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    openFile = SelectFile("Select Database", "Microsoft Access Database (*.mdb)" & Chr$(0) & "*.mdb", &H4 + &H1000, "mdb", False, lastFile)
    If openFile <> "" Then
        LastOpenedType = e_LastOpened_Access
        dbPath = openFile
        dbType = e_databaseTypes_AccessFile
        If lastFile <> openFile Then
            Call SaveSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        End If
        Call SaveSetting(App.Title, DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Path", dbPath, HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        dbConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & dbPath & ";DefaultDir=" & DetermineDirectory(dbPath) & ";"
        Call SetupDatabase
    End If
    Exit Sub
e_Trap:
    Call MessageBox(Me.hwnd, "Error:" & Err.Description & " (" & Err.Number & ")", vbOKOnly + vbCritical, "Error")
End Sub


Private Sub mnuOpenNetwork_Click()
    Call SaveDefaultTable
    frmNetwork.Show vbModal, Me
End Sub

Private Sub mnuedit_Click()
    If cmbTables.Text = DEF_CUSTOM_SQL Then
        mnuDropTable.Enabled = False
    Else
        mnuDropTable.Enabled = True
    End If
    If gridData.Row <= 0 And gridData.SelStartCol <> -1 And adoData.Recordset.Fields.Count > 1 Then
        mnuDeleteColumn.Enabled = True
    Else
        mnuDeleteColumn.Enabled = False
    End If
    If cmbTables.Text <> DEF_CUSTOM_SQL And adoData.Recordset.Fields.Count > 0 Then
        mnuRenameColumn.Enabled = True
    Else
        mnuRenameColumn.Enabled = False
    End If
End Sub

Private Sub mnuPurgeDate_Click()
    frmPurgeDate.cmbTables.ListIndex = cmbTables.ListIndex
    frmPurgeDate.Show vbModal, Me
End Sub

Private Sub mnuReload_Click()
    Call SetupDatabase(cmbTables.Text)
End Sub

Private Sub mnuRenameColumn_Click()
    Call frmRenameColumn.ReloadColumns(gridData.SelStartCol)
    frmRenameColumn.Show vbModal, Me
End Sub

Private Sub mnuRenameTable_Click()
    frmRenameTable.cmbTables.ListIndex = cmbTables.ListIndex
    frmRenameTable.Show vbModal, Me
End Sub

Private Sub mnuShowSQL_Click()
    mnuShowSQL.Checked = Not mnuShowSQL.Checked
    Call Form_Resize
End Sub

Private Sub mnuViewColumns_Click()
    frmViewColumns.Show vbModal, Me
End Sub

Private Sub txtSqlStatement_Change()
    If Trim(txtSqlStatement) = "" Then
        cmdExecute.Enabled = False
    Else
        cmdExecute.Enabled = True
        cmdExecute.Default = True
        If LockTextBox = False Then
            LockTextBox = True
            cmbTables.ListIndex = cmbTables.ListCount - 1
            LockTextBox = False
        End If
    End If
End Sub

Private Sub txtSqlStatement_LostFocus()
    cmdExecute.Default = False
End Sub