VB工程中的数据库文件怎么打开

'Example Name: Creating a Quiz Application

'------------------------------------------
'
' BAS Code: KidzQuiz.bas 
'
'------------------------------------------
Option Explicit

Public Const LB_SETTABSTOPS = &H192

Public Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" _
  (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
   ByVal lpDefault As String, ByVal lpReturnedString As String, _
   ByVal nSize As Long, ByVal lpFileName As String) As Long
   
Public Declare Function WritePrivateProfileString Lib "kernel32" _
   Alias "WritePrivateProfileStringA" _
  (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
   ByVal lpString As Any, ByVal lpFileName As String) As Long
   
Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, lParam As Any) As Long
    

'this array holds the questions loaded
'from the file. It's dimensions are set
'in the Begin routine once the number
'of questions in a section are known.
Public Questions() As String

'the ini file containing the questions
Public sIniQFile As String

'the ini section chosen by the user
Public iniQuizSection As String

'a flag to tell the HiScores form to display
'the Add Name dialog when shown.
Public GetHiScoreNameFlag As Long

'the name of the file containing the high scores
Public sHighScoreFile As String

'this is the user-defined type used to store
'the high scores. It is currently set for a
'maximum log of the 40 top scores.
Type QuizStudentsTopScores
  SNames(1 To 40)     As String * 24
  SDate(1 To 40)      As Single
  SScores(1 To 40)    As Integer
End Type

'this is what the above Type will be known
'as in the HiScore form routines
Public TopScores As QuizStudentsTopScores


Public Function ppGetItemsInfo(Group As String, _
                               item As String, _
                               sIniQFile As String) As String

'This function calls the GetPrivateProfileString
'function with the section title in Group.
'Returned is the string value corresponding to item.

  Dim ret As String
  Dim valid   As Long
  
  ret = Space(1024)
  valid = GetPrivateProfileString(Group, item, "", ret, Len(ret), sIniQFile)
  ppGetItemsInfo = Left(ret, valid)


End Function


Public Function ppStripItem(startStrg As String) As String

'this takes a string separated by Chr(0)'s,
'splits off 1 item, and shortens the string
'so that the next item is ready for removal.

  Dim pos As Long
  Dim item As String

  pos = InStr(startStrg, Chr$(0))

  If pos Then
    item = Mid(startStrg, 1, pos - 1)
    startStrg = Mid(startStrg, pos + 1, Len(startStrg))
    ppStripItem = item
  End If

End Function


Public Function ppExtractItem(startStrg As String) As String

'this takes a string separated by commas,
'splits off 1 item, and shortens the string
'so that the next item is ready for removal.

  Dim pos As Long
  Dim item As String
  
  pos = InStr(startStrg, ",")
     
  If pos Then
   
    item = Mid(startStrg, 1, pos - 1)
    startStrg = Mid(startStrg, pos + 1, Len(startStrg))
    ppExtractItem = item
    Exit Function
  
  Else:
  
    ppExtractItem = startStrg
    startStrg = ""
    
  End If
  
End Function


Sub QuickSortScores(TopScores As QuizStudentsTopScores, l As Long, r As Long)
   
   'Dim working variables
    Dim i As Long, j As Long
    Dim x As Long
    
   'dim tmp variables for use below
    Dim tmp1 As Long
    Dim tmp2 As Single
    Dim tmp3 As String
    
   '----------------------------------------
   'begin sort
   
   'assign working variables the values
   'passed to the sub in L & R
    i = l
    j = r
    
   'get the item halfway (x) through the data
   'determined by the range passed (L to r)
    x = TopScores.SScores((l + r) / 2)
    
   'x now holds the last name halfway through the array
   
   'compare rank of i to j and assign the 2 temp
   'variables that data for comparison later
    While (i <= j)
        
      'compare strings of compareI, i and r with the name in x
      'and assign new tmp values if a lower item found
       While (TopScores.SScores(i) > x And i < r)
           i = i + 1
       Wend
       
      'compare strings of compareJ, j and l with the name in x
      'and assign new tmp values if a higher item found
       While (x > TopScores.SScores(j) And j > l)
           j = j - 1
       Wend

       'determine the assignment action based on
       'the final i & j relative positions.  When i <= j,
       'swap the values of the last highest and last lowest items.
        If (i <= j) Then
        
          '---------------------------------------------
           '1a. assign tmp the value of the type TopScores(i)
           '2a. swap TopScores(j) for TopScores(i)
           '3a. reassign the value of tmp to the type TopScores(j)
            tmp1 = TopScores.SScores(i)
            TopScores.SScores(i) = TopScores.SScores(j)
            TopScores.SScores(j) = tmp1

            tmp2 = TopScores.SDate(i)
            TopScores.SDate(i) = TopScores.SDate(j)
            TopScores.SDate(j) = tmp2

            tmp3 = TopScores.SNames(i)
            TopScores.SNames(i) = TopScores.SNames(j)
            TopScores.SNames(j) = tmp3

          '---------------------------------------------
          'change the start  stop items
            i = i + 1
            j = j - 1
            
      End If
    Wend
    
   'if the original l is still less than j, then call
   'the sub again with l & j as the start & stop points
    If (l < j) Then QuickSortScores TopScores, l, j
    
   'or if the original l is still less than j, then call
   'the sub again with i & r as the start & stop points
    If (i < r) Then QuickSortScores TopScores, i, r

End Sub


Function FileExists(ByVal strPathName As String) As Boolean
    
'Returns: True if file exists, False otherwise
    
  Dim hFile As Long
  On Local Error Resume Next

 'Remove any trailing directory separator character
  If Right$(strPathName, 1) = "\" Then
     strPathName = Left$(strPathName, Len(strPathName) - 1)
  End If

 'Attempt to open the file, return value of
 'this function is False if an error occurs
 'on open, True otherwise
  hFile = FreeFile
  Open strPathName For Input As hFile

  FileExists = Err = 0

  Close hFile
  Err = 0
    
End Function