frmmain.frm

可直接打开编辑网络数据库

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 = "记录数:" & adoData.Recordset.RecordCount
    imgLoading.Visible = False
    LockTextBox = False
    Exit Sub
e_Trap:
    lblStatus.caption = "错误:" & 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 = "命令错误:" & 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("TC网络数据库系统", DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "Database Password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
End Sub

Private Sub mnuCompact_Click()
Dim JetEngine As New JRO.JetEngine
Dim tempFilename As String
Dim startingType As String
Dim endingType As String
Dim existingTable As String
Dim errorMessage As String
    
    On Error GoTo e_Trap
    
    If Dir(dbPath) = "" Or Trim(dbPath) = "" Then Exit Sub
    
    Call frmConnecting.ShowConnecting("连接到 " & "Compacting Access Database...", Me)
    If dbObj.State = adStateOpen Then
        On Error Resume Next
        existingTable = frmMain.cmbTables.Text
        Set dbObj = New ADODB.Connection
        Set adoData = New ADODB.Connection
        adoData.Recordset.ActiveConnection = Nothing
        On Error GoTo e_Trap
    End If
    
    tempFilename = Mid(dbPath, 1, Len(dbPath) - 4) & "(备份).mdb"
    If Dir(tempFilename) <> "" Then
        Kill tempFilename
    End If
    
    startingType = "Provider=Microsoft.Jet.OLEDB." & DEF_ACCESS97_OLEDB & ";" & "Data Source=" & dbPath & ";"
    
    startingType = "Jet OLEDB:Engine Type=4;" & "Data Source=" & dbPath
    endingType = "Provider=Microsoft.Jet.OLEDB." & DEF_ACCESS2K_OLEDB & ";" & "Data Source=" & tempFilename & ";"
    
    JetEngine.CompactDatabase startingType, endingType
            
    If Dir(tempFilename) <> "" Then
        Kill dbPath
        Call FileCopy(tempFilename, dbPath)
        Kill tempFilename
    End If
    
    frmConnecting.Hide
    Call frmMain.SetupDatabase(existingTable)
    Exit Sub
e_Trap:
    errorMessage = "错误: 过滤 AccessDatabase - " & Err.Description & " (" & Err.Number & ")"
    Call MsgBox(errorMessage, vbOKOnly + vbCritical, "Compact Error")
    frmConnecting.Hide
    Call frmMain.SetupDatabase(existingTable)
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, "真删除： " & 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, "真删除现成表数据" & cmbTables.Text & "?", vbYesNo + vbQuestion, "删除表")
    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, "请选择一个" & Title, vbOKCancel + vbInformation, "丢失文件名")
            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("TC网络数据库系统", DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, " Database path", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
    openFile = SelectFile("选择数据库", "Microsoft Access Database (*.mdb)" & Chr$(0) & "*.mdb", &H4 + &H1000, "mdb", False, lastFile)
    
    Surrpath = openFile 'ltw
    
   Open App.Path + "\DataSet.ini" For Output As #1
   
   Write #1, openFile
   
   Close #1
   
   
    
    If openFile <> "" Then
        LastOpenedType = e_LastOpened_Access
        dbPath = openFile
        dbType = e_databaseTypes_AccessFile
        If lastFile <> openFile Then
            Call SaveSetting("TC网络数据库系统", DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "database password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        End If
        Call SaveSetting("TC网络数据库系统", 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, "错误:" & Err.Description & " (" & Err.Number & ")", vbOKOnly + vbCritical, "错误")
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 adoData.Recordset Is Nothing Then
        mnuDeleteColumn.Enabled = False
        mnuRenameColumn.Enabled = False
    Else
        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 If
End Sub

Private Sub mnuprint_Click()
 MsgBox "您需与开发商联系，购买本功能！", , "抱歉！"
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 mnu查询_Click()
frmfine.Show vbModal, Me
End Sub

Private Sub mnu关于_Click()
    frmAbout.Show
End Sub

Private Sub munbakdata_Click()
  copyfiles.Show vbModal, Me
End Sub

Private Sub muntc_Click()
Dim BackedFile As String

  Open App.Path + "\DataSet.ini" For Input As #1
   
  Line Input #1, BackedFile
  
  BackedFile = Mid(BackedFile, 2, Len(BackedFile) - 2)
      
  Close #1
  
  If Right$(BackedFile, 4) = ".mdb" Then
  
  '**************************************************************************************
    Dim openFile As String
    Dim lastFile As String
    On Error GoTo e_Trap
    
    Call SaveDefaultTable  '原来不为注解_
    
     openFile = BackedFile
    
    If openFile <> "" Then
        LastOpenedType = e_LastOpened_Access
        dbPath = openFile
        dbType = e_databaseTypes_AccessFile
        If lastFile <> openFile Then
            Call SaveSetting("TC网络数据库系统", DEF_REGISTRY_CONNECTIONS & "\" & DEF_ACCESS, "database password", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Database")
        End If
        Call SaveSetting("TC网络数据库系统", 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, "错误:" & Err.Description & " (" & Err.Number & ")", vbOKOnly + vbCritical, "错误")
'****************************************************************************************
Else
    MsgBox "打开的数据文件不存在！", vbOKOnly, "警告"
    
End If
End Sub

Private Sub mun添加_Click()
frmAdd.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