Čtyři testy připravenosti diskety

Private Declare Function SetErrorMode Lib "kernel32" _ (ByVal wMode 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 Const SEM_FAILCRITICALERRORS = &H1 
Private Const SEM_NOOPENFILEERRORBOX = &H8000
Private Const OPEN_EXISTING As Long = 3 
Private Const OPEN_ALWAYS As Long = 4 
Private Const FILE_SHARE_READ As Long = &H1 
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const INVALID_HANDLE_VALUE = -1

Public Function IsUsualDirFloppyDriveReady(sDrive As String) As Boolean 
   'použije metodu Dir. 
   On Error Resume Next 
   IsUsualDirFloppyDriveReady = Dir(sDrive) <> "" 
   On Local Error GoTo 0 
End Function 

Private Function IsDirFloppyDriveReady(sDrive As String) As Boolean 
   On Local Error Resume Next 
   Dim oldErrMode As Long 
   'Pozastavení chybových hlášek 
   oldErrMode = SetErrorMode(SEM_FAILCRITICALERRORS) 
   'Provedeme metodu Dir
   IsDirFloppyDriveReady = Dir(sDrive) > "" 
   'Obnovení původního chybového stavu 
   Call SetErrorMode(oldErrMode) 
   On Local Error GoTo 0 
End Function 

Private Function IsFileSysFloppyDriveReady(sDrive As String) As Boolean 
   Dim fs As FileSystemObject 
   Set fs = New FileSystemObject
   IsFileSysFloppyDriveReady = fs.GetDrive(sDrive).IsReady 
   Set fs = Nothing 
End Function 

Private Function IsVolumeReady(sDrive As String) As Boolean 
   Dim hFile As Long 
   hFile = CreateFile(sDrive, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0, 0&)    
   IsVolumeReady = hFile <> INVALID_HANDLE_VALUE 
   Call CloseHandle(hFile) 
End Function

Na událost Click tlačítek:

Private Sub Command1_Click(Index As Integer) 
   Dim success As Boolean 
   Select Case Index 
      Case 0: success = IsUsualDirFloppyDriveReady("A:") 
      Case 1: success = IsFileSysFloppyDriveReady("A:") 
      Case 2: success = IsDirFloppyDriveReady("A:") 
      Case 3: success = IsVolumeReady("\\.\A:") 
   End Select 
   If success Then 
      MsgBox "Test diskety: Disketa připravena." 
   Else
      MsgBox "Test diskety: Disketa není vložena." 
   End If 
End Sub

Spusťte projekt a otestujte tlačítka.

Zpět