VB 编程·API 专区·API实例解析·使用历史文件记录 -- 追寻梦想＞编程乐园

　　Visual Basic 提供了一个标准的注册表位置以存储创建于 Visual Basic 的应用程序的程序信息，同时VB也提供了几个标准的语句或函数来处理存储在应用程序注册位置的程序设置如GetSetting函数、SaveSetting 语句、DeleteSetting 语句。本例的历史记录(是最近打开文件的记录，例如WORD软件)就是用这几个函数实现的。

　　为了学习方便，提供的源码已经作了详细的中文注释，看看源码框中的代码：

'-----------------------------------------
'           使用历史记录的例子
'-----------------------------------------
'           洪恩在线  求知无限
'-----------------------------------------
'Visual Basic 提供了一个标准的注册表位置以存储创建于 Visual Basic 的应用程序的程序信息：
'HKEY_CURRENT_USER\Software\VB and VBA Program Settings\appname\section\key
    
'Visual Basic 也提供了四个语句或函数来处理存储在应用程序注册位置的程序设置值。
'函数或语句             描述

'GetSetting 函数        检索注册表设置值。
'SaveSetting 语句       保存或创建注册表设置值。
'GetAllSettings 函数    返回一个包含多项注册表设置值的数组。
'DeleteSetting 语句     删除注册表设置值。
'-----------------------------------------
'本例中使用了除GetAllSettings 函数之外的几个函数或语句
'-----------------------------------------
'如果仅检索一项注册表设置值，通过以下的语法使用 GetSetting 函数：
'GetSetting(appname, section, key[, default])

'各参数的意义: appname,     section, key,       Value
'             应用程序名称，表的名称，表项的名称，表项的值

'注：这些名称是我们自己定义的，而不是系统默认值
'本例中注册表的结构如下所示：
'应用程序名称： Demo
'表的名称：     Rfile
'---------------表项名----------表项的值---
'表项1：        FirstFile       0
'表项2：        File0           第一个历史文件的路径
'表项2：        File1           第二个历史文件的路径
'表项2：        File2           第三个历史文件的路径
'表项2：        File3           第四个历史文件的路径
'-----------------------------------------
'按以下语法使用 SaveSetting 语句：
'SaveSetting appname, section, Key, Value

'通过以下语法使用 DeleteSetting 语句：
'DeleteSetting(appname, section, key)
'-----------------------------------------
Option Explicit
'A_Name是表示应用程序名称的变量
Dim A_Name As String
'S_Name是表示表的名称的变量
Dim S_Name As String
'MaxRFiles设置最多可以记录历史文件的数量，我们自己可以更改
Const MaxRFiles = 4

'当“退出程序”按钮被按下时
Private Sub CmdExit_Click()
  Unload Me
End Sub

'当“清除历史记录”按钮被按下时
Private Sub CmdClear_Click()
  '调用ClearRecentFiles[清除历史记录的子过程]
  ClearRecentFiles
End Sub

'当主窗体加载时
Private Sub Form_Load()
  A_Name = "Demo"
  S_Name = "RFile"
  '调用ReadRecentFiles[读最近历史记录的子过程]
  ReadRecentFiles
End Sub

'当“退出”菜单项被点击时
Private Sub mExit_Click()
 Unload Me
End Sub

'当历史记录文件的菜单项被点击时
Private Sub mLastFile_Click(Index As Integer)
  '更新历史记录
  UpdateRecentFiles Index
End Sub

'当“打开”菜单项被点击时
Private Sub mOpen_Click()
Dim fIndex As Integer

On Error Resume Next

CommonDialog1.CancelError = True   '如果在打开文件对话框中按下“取消”按钮，则进行错误响应
CommonDialog1.DialogTitle = "打开文件"
CommonDialog1.FileName = ""
CommonDialog1.Filter = "所有文件(*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly

CommonDialog1.ShowOpen
If Err = cdlCancel Then            '“取消”按钮按下时，进行错误处理

Else

  fIndex = InRecentFiles(CommonDialog1.FileName)
  If fIndex > MaxRFiles Then
    WriteRecentFiles CommonDialog1.FileName
  Else
    UpdateRecentFiles fIndex
  End If
End If

End Sub

'将打开的文件路径写入注册表的子过程
Private Sub WriteRecentFiles(FileName As String)
  Dim fileptr As Integer
  If Len(Trim(FileName)) Then
    fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
    fileptr = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
    SaveSetting A_Name, S_Name, "FirstFile", fileptr & ""
    SaveSetting A_Name, S_Name, "File" & fileptr, FileName
    ReadRecentFiles
  End If
End Sub

'读最近历史文件的子过程
Private Sub ReadRecentFiles()
    Dim i As Integer
    Dim fileptr As Integer
    Dim rFile As String
    Dim rCount As Integer
    'fileptr返回第一个文件的位置
    'Var函数返回包含于字符串内的数字，字符串中是一个适当类型的数值
    fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
    '&运算符用来强制两个表达式作字符串连接。
    rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
    rCount = 0
    
    '这个循环的作用是依次从注册表中读取历史记录，然后添加在“文件”菜单中
    Do While Len(rFile) And rCount < MaxRFiles
      
      '将读到的历史记录前面加上序号，添加在菜单中，
      '这些菜单项本来就存在，只不过在没有内容时隐藏起来罢了。
      mLastFile(rCount).Caption = "&" & (rCount + 1) & " " & rFile
      mLastFile(rCount).Visible = True
      
      'IIf函数，根据表达式的值，来返回两部分中的其中一个
      '很晦涩但简练的语句，实在理解不了的话，可用下面语句代替：
      '     If (fileptr + 1) < MaxRFiles Then
      '          fileptr = fileptr + 1
      '     Else
      '          fileptr = 0
      '     End If
      fileptr = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
      
      '接着读下一条历史记录
      rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
      rCount = rCount + 1
    Loop
    
    '如果记录数为0，则显示“无历史文件”菜单项
    If rCount = 0 Then
      mLastFile(rCount).Visible = True
      mLastFile(rCount).Caption = "无历史文件"
      rCount = 1
    End If
    For i = rCount To MaxRFiles - 1
      mLastFile(i).Visible = False
    Next
End Sub

'判断打开的文件是否已经存在于历史文件中的函数
Private Function InRecentFiles(strFile As String) As Integer
    Dim i As Integer
    Dim bFound As Boolean

    '将新的文件路径与菜单中的历史文件比较，如果有相同，函数的返回值为菜单项的索引值
    For i = 0 To MaxRFiles - 1
        If mLastFile(i).Visible And strFile = Mid$(mLastFile(i).Caption, 4) Then
            InRecentFiles = i
            Exit Function
        End If
    Next
    
    '否则返回5
    InRecentFiles = MaxRFiles + 1
End Function

'清除历史记录的子过程
Public Sub ClearRecentFiles()
  On Error Resume Next
  Dim i As Integer
  
  '删除"FirstFile"表项
  DeleteSetting A_Name, S_Name, "FirstFile"
  '依次删除历史记录的表项
  For i = 0 To MaxRFiles
    DeleteSetting A_Name, S_Name, "File" & i
  Next
  
  '将菜单项作相应的处理
  mLastFile(0).Visible = True
  mLastFile(0).Caption = "无历史文件"
  For i = 1 To MaxRFiles - 1
      mLastFile(i).Visible = False
  Next
End Sub

'更新历史记录文件的子过程
Public Sub UpdateRecentFiles(fIndex As Integer)
    Dim i As Integer
    Dim fileptr As Integer, FirstPtr As Integer
    Dim FilePtr1 As Integer
    Dim rFile As String, OldFile As String
    Dim rCount As Integer
    If fIndex = 0 Then Exit Sub
    '第一个文件的位置
    FirstPtr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
    If fIndex = MaxRFiles - 1 Then
      '照上面解释理解吧
      FirstPtr = IIf(FirstPtr - 1 >= 0, FirstPtr - 1, MaxRFiles - 1)
      'CStr函数都可以强制将一个表达式转换成字符串类型数据
      SaveSetting A_Name, S_Name, "FirstFile", CStr(FirstPtr)
      '读历史记录
      ReadRecentFiles
      Exit Sub
    End If
    fileptr = fIndex + FirstPtr
    If fileptr >= MaxRFiles Then fileptr = fileptr - MaxRFiles
    OldFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
    FilePtr1 = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
    'FilePtr1 = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
    rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")

    Do While FirstPtr <> fileptr And Len(rFile) > 0
      SaveSetting A_Name, S_Name, "File" & fileptr, rFile
      fileptr = FilePtr1
      FilePtr1 = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
      'FilePtr1 = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
      rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")
    Loop
    
    SaveSetting A_Name, S_Name, "File" & FirstPtr, OldFile
    'SaveSetting A_Name, S_Name, "FirstFile", CStr(fileptr)
    ReadRecentFiles
'    WriteRecentFiles OldFile

End Sub

　　如下所示就是现在名为DEMO的程序的程序信息在注册表中所处的位置，VB提供的标准注册表位置是在： HKEY_CURRENT_USER\Software\VB and VBA Program Settings\appname\ 下，假设我们当前程序名为DEMO，则在注册表的相应位置就可以看到程序的信息。

　　下面一起看看怎么用上面提到的几个函数和语句对注册表进行操作。这几个函数的作用分别是：
　　GetSetting 函数　　　检索注册表设置值。
　　SaveSetting 语句　　保存或创建注册表设置值。
　　GetAllSettings 函数　返回一个包含多项注册表设置值的数组。
　　DeleteSetting 语句　删除注册表设置值。

　　以GetSetting 函数为例，GetSetting 函数使用的语法为：
　　GetSetting(appname, section, key[, default])
　　各参数的意义如下表:

　　函数的返回值是得到的键值。例如我们使用下面语句：
　　Filename1= GetSetting("Demo", "RFile", "File1", "")
　　就能得到上图所示的第二条历史记录的值。

　　其它函数的用法分别为：
　　SaveSetting(appname,section, Key, Value)
　　DeleteSetting(appname, section, key)
　　各个参数的意义跟 GetSetting函数是相同的。

　　在例程序中，每次打开一个文件，程序会判断这个文件是不是历史记录中已有的记录，如果不是，便通过SaveSetting语句将文件的路径写入注册表，而当选择“清除历史记录”时，程序通过DeleteSetting 语句删除所有的历史记录。

　　使用这几个函数，还能实现其它的功能，比如保存程序的初始化设置，保存密码等，我们都可以仿照源程序中的语句来实现，如果有兴趣的话，试一试吧。