Rubrik: Dateisystem · Laufwerke | VB-Versionen: VB4, VB5, VB6 | 27.02.07 |
Laufwerk bereit/schreibgeschützt? Mit dieser Funktion lässt sich ermitteln, ob ein bestimmtes Laufwerk bereit ist und optional auch, ob auf den Datenträger geschrieben werden kann. | ||
Autor: Dieter Otter | Bewertung: | Views: 9.132 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Mit nachfolgender Funktion lässt sich prüfen, ob ein bestimmtes Laufwerk bereit ist (bspw. ein Disketten- oder ZIP-Laufwerk) und optional auch, ob auf den Datenträger geschrieben werden kann.
Fügen Sie nachfolgenden Code in ein Modul ein:
Option Explicit ' Benötigte API-Deklaration 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 SetVolumeLabel Lib "kernel32" _ Alias "SetVolumeLabelA" ( _ ByVal lpRootPathName As String, _ ByVal lpVolumeName As String) As Long
Public Function CheckDrive(ByVal sDrive As String, _ Optional ByVal bForeCheckWriteAccess As Boolean = False) As Boolean ' Prüft, ob der Datenträger bereit ist und ' optional, ob darauf geschrieben werden kann Dim bResult As Boolean Dim sVolName As String Dim sTemp As String bResult = False On Error GoTo ErrHandler ' Datenträgerbezeichnung lesen If Len(sDrive) = 1 Then sDrive = sDrive & ":" If Len(sDrive) = 2 Then sDrive = sDrive & "\" sTemp = Space$(255) sVolName = Space$(255) If GetVolumeInformation(sDrive, sVolName, Len(sVolName), _ 0&, 0&, 0&, sTemp, Len(sTemp)) > 0 Then ' Falls kein Fehler auftrat, ist der Datenträger bereit bResult = True ' Falls zusätzlich geprüft werden soll, ob auf ' den Datenträger geschrieben werden kann... If bForeCheckWriteAccess Then If InStr(sVolName, Chr$(0)) > 0 Then sVolName = Left$(sVolName, InStr(sVolName, Chr$(0)) - 1) End If bResult = (SetVolumeLabel(sDrive, sVolName) <> 0) End If End If ErrHandler: CheckDrive = bResult End Function
Aufrufbeispiele:
' Prüfen, ob in Laufwerk A: eine Diskette eingelegt ' ist und ob darauf geschrieben werden kann If CheckDrive("A:", True) = False Then MsgBox "Entweder keine Diskette im Laufwerk A: oder " & _ "der Datenträger ist schreibgeschützt!", vbCritical End If
' Prüfen, ob Laufwerk D: bereit If CheckDrive("D:") Then ' ... End If