frmmain.frm

VB6程序设计参考手册 -独立源码 VB6程序设计参考手册 -独立源码

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "判断文件是否存在？"
   ClientHeight    =   2460
   ClientLeft      =   1125
   ClientTop       =   1515
   ClientWidth     =   5025
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   5025
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdMakeError 
      Caption         =   "模拟一个错误"
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      Top             =   1920
      Width           =   2055
   End
   Begin VB.CommandButton cmdCentral 
      Caption         =   "集中化的错误处理"
      Height          =   375
      Left            =   480
      TabIndex        =   3
      Top             =   1920
      Width           =   2055
   End
   Begin VB.TextBox txtFileSpec 
      Height          =   375
      Left            =   480
      TabIndex        =   2
      Text            =   "*:\error.xyz"
      Top             =   600
      Width           =   3255
   End
   Begin VB.CommandButton cmdInline 
      Caption         =   "进行错误处理"
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      Top             =   1320
      Width           =   2055
   End
   Begin VB.CommandButton cmdNone 
      Caption         =   "不进行错误处理"
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   1320
      Width           =   2055
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "此处输入一个无效的文件名:"
      Height          =   180
      Left            =   480
      TabIndex        =   5
      Top             =   360
      Width           =   2250
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

''定义文件错误代码的常数
Const mnErrBadFileNameOrNumber = 52
Const mnErrBadFileMode = 54
Const mnErrFileAlreadyOpen = 55
Const mnErrDeviceIO = 57
Const mnErrDiskFull = 61
Const mnErrInputPastEndOfFile = 62
Const mnErrBadFileName = 64
Const mnErrDeviceUnavailable = 68
Const mnErrDiskNotReady = 71
Const mnErrPathDoesNotExist = 76

''集中化的错误处理
Private Sub cmdCentral_Click()
    Dim strErrnum As String
    Dim intErr As Integer
    Dim intReturn As Integer
    
    On Error GoTo errHandler
    ''取得错误代码
    strErrnum = InputBox("请输入错误号", "错误", "68")
    intErr = Val(strErrnum)
    Err.Raise Number:=intErr
    Exit Sub
    
errHandler:
    ''调用FileErrors函数判断错误代码
    intReturn = FileErrors()
    ''根据不同的返回值，进行不同的操作
    If intReturn = 0 Then
        ''若返回值为0，则重新执行出错的语句
        Resume
    ElseIf intReturn = 1 Then
        ''若返回值为1，则继续执行出错语句的下一条语句
        Resume Next
    ElseIf intReturn = 2 Then
        MsgBox "无法恢复的错误"
        End
    Else
        MsgBox "未知错误"
        Resume Next
    End If
        
End Sub

Private Sub cmdInline_Click()
    Dim blnResult As Boolean
        
    Dim strFileName As String
    strFileName = txtFileSpec.Text
    
    Dim Msg As String
    ' 启动错误陷井，如果检测到任何错误，错误处理程序均响应。
    On Error GoTo errHandler
        blnResult = (Dir(strFileName) <> "")
        ' 如果未发生错误，就退出过程，以免执行错误处理程序。
        Exit Sub

errHandler:      ''错误处理程序
    If (Err.Number = mnErrDiskNotReady) Then
        Msg = "在驱动器中插入一张软盘并关好驱动器。"
        ' 显示有惊叹号图标以及“确定”和“取消”按钮的消息框。
        If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
            Resume
        Else
            Resume Next
        End If
    ElseIf Err.Number = mnErrDeviceUnavailable Then
        Msg = "驱动器或路径不存在： " & strFileName
        MsgBox Msg, vbExclamation
        Resume Next
    Else
        Msg = "未知的错误 #" & Str(Err.Number) & " 发生: " & Err.Description
        ' 显示有停止符号图标以及“确定”按钮的消息框。
        MsgBox Msg, vbCritical
        
        Resume Next
    End If

    Resume
End Sub

Private Sub cmdMakeError_Click()
   ' 模拟“磁盘未准备好”错误。
    Err.Raise Number:=71
End Sub

''不进行错误处理
Private Sub cmdNone_Click()
    Dim blnResult As Boolean
    ''若txtFileSpec.Text所指定的文件名，不存在，则VB会中断程序的运行
    blnResult = (Dir(txtFileSpec.Text) <> "")
End Sub

Function FileErrors() As Integer
    Dim intMsgType As Integer
    Dim strMsg As String
    Dim intResponse As Integer
    ''intResponse定义了返回值
    ''若返回值为0，表示继续当前的操作
    ''若返回值为1，表示继续下一个操作
    ''若返回值为2，表示当前错误不可恢复
    ''若返回值为3，表示当前错误无法辨认

    intMsgType = vbExclamation
    Select Case Err.Number
        Case mnErrDeviceUnavailable             ' 错误 68
            strMsg = "设备不可用。"
            intMsgType = vbExclamation + vbOKCancel
        Case mnErrDiskNotReady                  ' 错误 71
            strMsg = "在驱动器中插入一张软盘并关好驱动器。"
            intMsgType = vbExclamation + vbOKCancel
        Case mnErrDeviceIO                      ' 错误 57
            strMsg = "内部磁盘错误。"
            intMsgType = vbExclamation + vbOKOnly
        Case mnErrDiskFull                      ' 错误 61
            strMsg = "磁盘已满。继续吗？"
            intMsgType = vbExclamation + vbAbortRetryIgnore
        Case mnErrBadFileName, mnErrBadFileNameOrNumber ' 错误 64 & 52
            strMsg = "文件名非法。"
            intMsgType = vbExclamation + vbOKCancel
        Case mnErrPathDoesNotExist                ' 错误 76
            strMsg = "路径不存在。"
            intMsgType = vbExclamation + vbOKCancel
        Case mnErrBadFileMode                     ' 错误 54
            strMsg = "不能以此访问类型打开文件。"
        Case mnErrFileAlreadyOpen                 ' 错误 55
            strMsg = "文件已被打开。"
            intMsgType = vbExclamation + vbOKOnly
        Case mnErrInputPastEndOfFile              ' 错误 62
            strMsg = "文件有一个不标准的文件结束标志，"
            strMsg = strMsg & "或企图读文件结束标志之后 "
            strMsg = strMsg & "的内容。"
            intMsgType = vbExclamation + vbAbortRetryIgnore
        Case Else
            FileErrors = 3
            Exit Function
    End Select
    
    intResponse = MsgBox(strMsg, intMsgType, "磁盘错误")
    Select Case intResponse
        Case 1, 4       ' “确定”, “重试”按钮。
            FileErrors = 0
        Case 2, 5       ' “取消”，“忽略”按钮。
            FileErrors = 1
        Case 3          ' “中止”按钮。
            FileErrors = 2
        Case Else
            FileErrors = 3
    End Select
End Function