Visual Basic Disk/Drive API Routines
SetErrorMode: Determine if a Floppy Drive is Ready
Posted:   Sunday September 12, 1999
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch


GetLogicalDriveStrings: An API 'DriveExists' Routine
FindFirstFile: An API 'FileExists' Routine
FindFirstFile: An API 'FolderExists' Routine

Visual Basic provides a few ways to test for the readiness of a removable drive both with intrinsic methods and with the assistance of the API. Each method has its advantages.

Most developers are familiar with the first method around since VB1 - performing a simple Dir() against the drive, trapping errors that may arise when there is no disk in the drive.

The FileSystemObject provides an IsReady property that will return a drive's state. However, this means distributing another component, and one that some claim to be plagued with problems. In addition, VB5 users must download the VB Scripting tool to get this file. And for end users who have disabled or removed scripting support, using the FSO is not an option.

Windows also provides a flag that an be set prior to calling any function that would typically cause a "critical error" dialog to appear (such as a "bad file name" error). The third method shows how to use this before calling a standard Dir() against the drive, and the makes a call to GetVolumeInformation for the drive.

If you are running VB4 of VB5 and do not have the FileSystemObject, you'll need to comment out the code from the IsFloppyReadyB() function.

 BAS Module Code

 Form Code
Add four command buttons in a control array to a form (Command1(0)-Command1(3)), and add the following code:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.

Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_ALL = &H10000000

Private Const FILE_ANY_ACCESS As Long = 0
Private Const FILE_READ_ACCESS  As Long = &H1
Private Const FILE_WRITE_ACCESS As Long = &H2


Private Declare Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" _
  (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, _
   ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, _
   lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, _
   ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long
Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   ByVal lpSecurityAttributes As Long, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long

Private Declare Function SetErrorMode Lib "kernel32" _
   (ByVal wMode As Long) As Long

Private Sub Form_Load()

   Command1(0).Caption = "Dir (Usual) Method"
   Command1(1).Caption = "FileSystemObject"
   Command1(2).Caption = "Dir w/SetErrorMode"
   Command1(3).Caption = "GetVolumeInformation"
End Sub

Private Sub Command1_Click(Index As Integer)

   Dim success As Boolean
   Select Case Index
      Case 0:
        'Dir method
         success = IsFloppyReadyA("A:")
      Case 1:
         success = IsFloppyReadyB("A:")
      Case 2:
        'SetErrorMode w/Dir
         success = IsFloppyReadyC("A:")
      Case 3:
         success = IsFloppyReadyD("A:")
   End Select
   If success Then
      MsgBox "Ready.", vbInformation, Command1(Index).Caption
      MsgBox "Not ready.", vbExclamation, Command1(Index).Caption
   End If
End Sub

Private Function IsFloppyReadyA(sDrive As String) As Boolean

  'do a Dir on the drive.
   On Error Resume Next
   IsFloppyReadyA = Dir(sDrive) <> ""
End Function

Private Function IsFloppyReadyB(sDrive As String) As Boolean

   Dim fs As FileSystemObject
   Set fs = New FileSystemObject
   IsFloppyReadyB = fs.GetDrive(sDrive).IsReady

   Set fs = Nothing
End Function

Private Function IsFloppyReadyC(sDrive As String) As Boolean

   On Local Error Resume Next
   Dim oldErrMode  As Long

  'suspend floppy disk errors
   oldErrMode = SetErrorMode(SEM_FAILCRITICALERRORS)
  'do a Dir on the drive.
   IsFloppyReadyC = Dir(sDrive) > ""
  'Put things back the way you found them
   Call SetErrorMode(oldErrMode)
   Call SetErrorMode(0)
   On Local Error GoTo 0

End Function

Private Function IsFloppyReadyD(sDrive As String) As Boolean
    Dim sVolumeName As String
    Dim dwVolumeSize  As Long

    sVolumeName = Space$(32)
    dwVolumeSize = Len(sVolumeName)

   'success at accessing the
   'drive returns a 1
    IsFloppyReadyD = GetVolumeInformation(sDrive, _
                                         sVolumeName, _
                                         dwVolumeSize, _
                                         0&, 0&, 0&, _
                                         vbNullString, _

End Function
Before running, set your error-handling mode (tools/Options/general tab) to "Break on unhandled errors".

SetErrorMode in the IsDirFloppyDriveReady() function controls whether the system will handle the specified types of serious errors, or whether the process will handle them. Passing SEM_FAILCRITICALERRORS tells the system not display the critical-error-handler message box. Instead, the system sends the error to the calling process. (By the way, I found that passing SEM_NOOPENFILEERRORBOX instead of SEM_FAILCRITICALERRORS will cause the function, when the drive is empty, to display the "Insert disk" message with the normal Abort, Retry and Ignore buttons.)


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter