bmain.bas

《VB6数据库开发指南》所有的例程的源码

Attribute VB_Name = "BMain"
Option Explicit

Global Const LISTVIEW_BUTTON = 1

Public fMainForm As frmMain

Sub Main()
    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Function GetNewDBName(dlg As CommonDialog) As String
' Get the desired name using the common dialog
On Error GoTo ProcError

  Dim strFileName As String
  
  ' setup the file save dialog file types
  dlg.DefaultExt = "mdb"
  dlg.DialogTitle = "Create Database"
  dlg.Filter = "VB Databases (*.mdb)|*.mdb"
  dlg.FilterIndex = 1
  ' setup flags
  dlg.Flags = _
    cdlOFNHideReadOnly Or _
    cdlOFNOverwritePrompt Or _
    cdlOFNPathMustExist
  ' setting CancelError means the control will
  ' raise an error if the user clicks Cancel
  dlg.CancelError = True
  ' show the SaveAs dialog
  dlg.ShowSave
  ' get the selected name
  strFileName = dlg.filename

ProcExit:
  GetNewDBName = strFileName
  Exit Function

ProcError:
  strFileName = ""
  Resume ProcExit

End Function
Public Function GetOpenDBName(dlg As CommonDialog) As String
' Get the desired name using the common dialog
On Error GoTo ProcError

  Dim strFileName As String
  
  ' setup the file save dialog file types
  dlg.DefaultExt = "mdb"
  dlg.DialogTitle = "Open Database"
  dlg.Filter = "VB Databases (*.mdb)|*.mdb"
  dlg.FilterIndex = 1
  ' setup flags
  dlg.Flags = _
    cdlOFNHideReadOnly Or _
    cdlOFNFileMustExist Or _
    cdlOFNPathMustExist
  ' setting CancelError means the control will
  ' raise an error if the user clicks Cancel
  dlg.CancelError = True
  ' show the SaveAs dialog
  dlg.ShowOpen
  ' get the selected name
  strFileName = dlg.filename

ProcExit:
  GetOpenDBName = strFileName
  Exit Function

ProcError:
  strFileName = ""
  Resume ProcExit

End Function

Public Sub CreateDB(strDBName As String)
' create the database

  Dim db As Database
  
  ' if desired, you can specify a version as the optional
  ' third parameter to the CreateDatabase method
  Set db = _
    DBEngine(0).CreateDatabase(strDBName, dbLangGeneral)

End Sub