home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / PGUIDE / ERRORS / ERRORS.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-11-23  |  4.5 KB  |  141 lines
  1. VERSION 5.00
  2. Begin VB.Form frmErrors 
  3.    Caption         =   "Error Handling Example"
  4.    ClientHeight    =   2670
  5.    ClientLeft      =   1140
  6.    ClientTop       =   1530
  7.    ClientWidth     =   5295
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   2670
  10.    ScaleWidth      =   5295
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdMakeError 
  13.       Caption         =   "Generate an Error"
  14.       Height          =   375
  15.       Left            =   2760
  16.       TabIndex        =   4
  17.       Top             =   1920
  18.       Width           =   2055
  19.    End
  20.    Begin VB.CommandButton cmdCentral 
  21.       Caption         =   "Centralized Error Handling"
  22.       Height          =   375
  23.       Left            =   480
  24.       TabIndex        =   3
  25.       Top             =   1920
  26.       Width           =   2055
  27.    End
  28.    Begin VB.TextBox txtFileSpec 
  29.       Height          =   375
  30.       Left            =   480
  31.       TabIndex        =   2
  32.       Text            =   "*:\error.xyz"
  33.       Top             =   600
  34.       Width           =   3255
  35.    End
  36.    Begin VB.CommandButton cmdInline 
  37.       Caption         =   "Inline Error Handling"
  38.       Height          =   375
  39.       Left            =   2760
  40.       TabIndex        =   1
  41.       Top             =   1320
  42.       Width           =   2055
  43.    End
  44.    Begin VB.CommandButton cmdNone 
  45.       Caption         =   "No Error Handling"
  46.       Height          =   375
  47.       Left            =   480
  48.       TabIndex        =   0
  49.       Top             =   1320
  50.       Width           =   2055
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "Enter a invalid File Spec here:"
  54.       Height          =   255
  55.       Left            =   480
  56.       TabIndex        =   5
  57.       Top             =   360
  58.       Width           =   3375
  59.    End
  60. Attribute VB_Name = "frmErrors"
  61. Attribute VB_GlobalNameSpace = False
  62. Attribute VB_Creatable = False
  63. Attribute VB_PredeclaredId = True
  64. Attribute VB_Exposed = False
  65. Option Explicit
  66. Private Sub cmdCentral_Click()
  67.     Dim strErrnum As String
  68.     Dim intErr As Integer
  69.     Dim intReturn As Integer
  70.     On Error GoTo CallFileErrors
  71.     strErrnum = InputBox("Enter an error number", "Errors", "68")
  72.     intErr = Val(strErrnum)
  73.     Err.Raise Number:=intErr
  74.     Exit Sub
  75. CallFileErrors:
  76.     intReturn = FileErrors()
  77.     If intReturn = 0 Then
  78.         Resume
  79.     ElseIf intReturn = 1 Then
  80.         Resume Next
  81.     ElseIf intReturn = 2 Then
  82.         MsgBox "Unrecoverable Error"
  83.         End
  84.     Else
  85.         MsgBox "Unknown Error"
  86.         Resume Next
  87.     End If
  88.         
  89. End Sub
  90. Private Sub cmdInline_Click()
  91.     Dim blnResult As Boolean
  92.     blnResult = FileExists2(txtFileSpec.Text)
  93. End Sub
  94. Private Sub cmdMakeError_Click()
  95.     Err.Raise Number:=71        ' Simulate "Disk Not Ready" error.
  96. End Sub
  97. Private Sub cmdNone_Click()
  98.     Dim blnResult As Boolean
  99.     blnResult = FileExists1(txtFileSpec.Text)
  100. End Sub
  101. Function FileExists1(filename) As Boolean
  102.     ' No error handling
  103.     FileExists1 = (Dir(filename) <> "")
  104. End Function
  105. Function FileExists2(filename) As Boolean
  106.     Dim Msg As String
  107.     ' Turn on error trapping so error handler responds
  108.     ' if any error is detected.
  109.     On Error GoTo CheckError
  110.         FileExists2 = (Dir(filename) <> "")
  111.         ' Avoid executing error handler if no error occurs.
  112.         Exit Function
  113. CheckError:                 ' Branch here if error occurs.
  114.     ' Define constants to represent intrinsic Visual Basic error
  115.     ' codes.
  116.     Const mnErrDiskNotReady = 71, mnErrDeviceUnavailable = 68
  117.     ' vbExclamation, vbOK, vbCancel, vbCritical, and vbOKCancel are
  118.     'constants defined in the VBA type library.
  119.     If (Err.Number = mnErrDiskNotReady) Then
  120.         Msg = "Put a floppy disk in the drive and close the door."
  121.         ' Display message box with an exclamation mark icon and with
  122.         ' OK and Cancel buttons.
  123.         If MsgBox(Msg, vbExclamation & vbOKCancel) = vbOK Then
  124.             Resume
  125.         Else
  126.             Resume Next
  127.         End If
  128.     ElseIf Err.Number = mnErrDeviceUnavailable Then
  129.         Msg = "This drive or path does not exist: " & filename
  130.         MsgBox Msg, vbExclamation
  131.         Resume Next
  132.     Else
  133.         Msg = "Unexpected error #" & Str(Err.Number) & " occurred: " _
  134.         & Err.Description
  135.         ' Display message box with Stop sign icon and OK button.
  136.         MsgBox Msg, vbCritical
  137.         Stop
  138.     End If
  139.     Resume
  140. End Function
  141.