集中化的错误处理

在应用程序中添加错误处理代码时，很快就会发现反复处理着的是相同的错误。经过仔细筹划，编写几个可供错误处理代码调用来处理公共错误情况的过程，这样就可减少代码的数量。

下列 FileErrors 函数过程显示了适合于已发生的错误的信息，在可能的情况下还允许用户选择按钮，为程序指定下一步应该执行的操作。然后 FileErrors 函数将代码返回到调用它的过程。代码的值指示程序应该执行哪个操作。注意，一定要在某个地方定义由用户定义的诸如 MnErrDeviceUnavailable 的常数，（或者全局定义，或者在包含过程的模块级别定义，或者在过程本身之中定义）。由于在 Visual Basic (VB) 对象库中定义了常数 vbExclamation，所以不需对它作声明。

Function FileErrors （）As Integer
   Dim intMsgType As Integer, strMsg As String
   Dim intResponse As Integer
   '返回值      含义
   ' 0                  继续
   ' 1                  继续下一个
   ' 2                  不可恢复的错误
   ' 3                  无法辨认的错误
   intMsgType = vbExclamation
   Select Case Err.Number
      Case MnErrDeviceUnavailable   '错误 68。
         strMsg = "That device appears unavailable."
         intMsgType = vbExclamation + 4
      Case MnErrDiskNotReady      ' 错误 71。
         strMsg = "Insert a disk in the drive "
         strMsg = strMsg & "and close the door."
         intMsgType = vbExclamation + 4
      Case MnErrDeviceIO         ' 错误 57。
         strMsg = "Internal disk error."
         intMsgType = vbExclamation + 4
      Case MnErrDiskFull         '错误 61。
         strMsg = "Disk is full. Continue?"
         intMsgType = vbExclamation + 3   
                              '错误 64 和 52。
      Case ErrBadFileName, ErrBadFileNameOrNumber
         strMsg = "That filename is illegal."
         intMsgType = vbExclamation + 4
      Case ErrPathDoesNotExi      ' 错误 76。
         strMsg = "That path doesn't exist."
         intMsgType = vbExclamation + 4
      Case ErrBadFileMode         ' 错误 54。
         strMsg = "Can't open your file for that "
         strMsg = strMsg & "type of access."
         intMsgType = vbExclamation + 4
      Case ErrFileAlreadyOpen   ' 错误 55。
         strMsg = "This file is already open."
         intMsgType = vbExclamation + 4
      Case ErrInputPastEndOfFile   ' 错误 62。
         strMsg = "This file has a nonstandard "
         strMsg = strMsg & "end-of-file marker, "
         strMsg = strMsg & "or an attempt was made ”
         strMsg = strMsg & “to read beyond "
         strMsg = strMsg & "the end-of-file marker."
         intMsgType = vbExclamation + 4
      Case Else
         FileErrors = 3
         Exit Function
   End Select
   intResponse = MsgBox (strMsg, intMsgType, _
   "Disk Error")
   Select Case intRresponse
      Case 1, 4      ' “确定”、“重试”按钮。
         FileErrors = 0
      Case 5         ' “忽略”按钮。
         FileErrors = 1
      Case 2, 3      ' “取消”、“结束”按钮。
         FileErrors = 2
      Case Else
         FileErrors = 3
   End Select
End Function

该过程处理公共文件和磁盘相关错误。如果错误与磁盘输入/输出无关，则返回数值 3。于是，调用该过程的过程或者自己处理错误，用 Raise 方法重新生成错误，或者调用另一过程来处理。

注意 在编写较大的应用程序时就会发现，在各种窗体和模块的几个过程中使用着相同的常数。要使这些常数为公有的，并在单独的标准模块中声明它们，这样就可以更好地组织代码并避免重复输入相同的声明。

无论在何处执行读磁盘或写磁盘过程，都可直接通过 FileErrors 过程的调用简化错误处理。例如，可能已用过这样的应用程序，它对是否要更换现有磁盘文件发出警告。相反，当试着打开不存在的文件时，许多应用程序都将预先提示该文件不存在，并询问是否要建立该文件。在这两个例子中，当应用程序将文件名传递到操作系统时都可能产生错误。

以下的检查例程使用 FileErrors 过程返回的值，由此决定有关磁盘错误事件中采用的操作。

Function ConfirmFile (FName As String, _
Operation As Integer) As Integer
'参数：
' Fname：检查并确认文件。
'操作：顺序文件访问方式的代码（输出、输入等）。
'注意：由于信息在 Operation 上被调整成有序模式，
      ' 而 Operation 是 <>，因此，过程以二进制
      ' 和随机访问方式工作。
'返回值：
      ' 1      确认操作不会引起问题。
      ' 0      决定不进行操作。
   Const conSaveFile = 1, conLoadFile = 2
   Const conReplaceFile = 1, conReadFile = 2
   Const conAddToFile = 3, conRandomFile = 4
   Const conBinaryFile = 5
   Dim intConfirmation As Integer
   Dim intAction As Integer
   Dim intErrNum As Integer, varMsg As Variant
   
   On Error GoTo ConfirmFileError   ' 打开错误捕获。
   FName = Dir(FName)         ' 检查文件是否存在。
   On Error GoTo 0            ' 关闭错误捕获。
   ' 如果用户正将文本保存到已存在的文件中...
   If FName <> "" And Operation = conReplaceFile Then
      varMsg = "The file " & FName &
      varMsg = varMsg & "already exists on " & vbCRLF
      varMsg = varMsg & "disk. Saving the text box " 
      varMsg = varMsg & & vbCRLF
      varMsg = varMsg & "contents to that file will "
      varMsg = varMsg & "destroy the file's current "
      varMsg = varMsg & "contents, " & vbCRLF _
      varMsg = varMsg & "replacing them with the "
      varMsg = varMsg & "text from the text box."
      varMsg = varMsg & vbCRLF & vbCRLF
      varMsg = varMsg & "Choose OK to replace file, "
      varMsg = varMsg & "Cancel to stop."
      intConfirmation = MsgBox(varMsg, 65, _
      "File Message")
   ' 如果用户想从不存在的文件中加载文本。
   ElseIf FName = "" And Operation = conReadFile Then
      varMsg = "The file " & FName
      varMsg = varMsg & " doesn't exist." & vbCRLF
      varMsg = varMsg & "Would you like to create and       varMsg = varMsg & "then edit it?" & vbCRLF
      varMsg = varMsg & vbCRLF & "Choose OK to "
      varMsg = varMsg & "create file, Cancel to stop."
      intConfirmation = MsgBox(varMsg, 65, _
      "File Message")
   ' 设置 intConfirmation = 2，如果 Fname 不存在，强迫过程返回 0。
   ElseIf FName = "" Then
      If Operation = conRandomFile Or _
      Operation = conBinaryFile Then
         intConfirmation = 2 
      End If
   ' 若文件存在而操作没有成功，则 intConfirmation = 0，过程返回 1。
   End If
   ' 如果没有框显示，则 intConfirmation = 0;
   ' 如果用户卸载“确定”，则无论如何 intConfirmation = 1，
   ' 并且 ConfirmFile 返回 1，确认期望的操作。
   ' 如果 intConfirmation > 1,则 ConfirmFile 返回 0，
   ' 因为用户不想完成该操作...
   If intConfirmation > 1 Then 
      ConfirmFile = 0 
   Else 
      ConfirmFile = 1
      If Confirmation = 1 Then
         ' 用户想创建文件。
         If Operation = conLoadFile Then
            ' 赋值 conReplaceFile，
            ' 使调用者明了将要发生的动作。
            Operation = conReplaceFile
         End If
      ' 返回代码，确认下一步是替换老文件还是创建新文件。
      End If
   End If
Exit Function
ConfirmFileError:
intAction = FileErrors
   Select Case intAction
      Case 0
         Resume
      Case 1
         Resume Next
      Case 2
         Exit Function
      Case Else
         intErrNum = Err.Number
         Err.Raise Number:=intErrNum
         Err.Clear
   End Select
End Function

ConfirmFile 过程接收对文件的指定，而该文件已被确认存在，该过程还接受附加信息，这些信息是有关实际打开一文件时使用的访问方式。如果要保存一个顺序文件（conReplaceFile），同时找到一个已经使用那个名称的文件（因此该文件要被覆盖），则提示用户确认将文件覆盖是可接受的。

如果要打开一个顺序文件（conReplaceFile），但未找到该文件，则提示用户确认应建立一个新文件。如果以随机或二进制访问方式打开一文件，则文件的存在与否，要么被确定（返回数值 1），要么被拒绝（返回数值 0）。如果在调用 Dir 时产生错误，则调用 FileErrors 过程来分析错误并提示用户采用合理的操作进程。