Code zu Dateioperationen in Classic Visual Basic

Ermitteln und Setzen von Laufwerksbezeichnungen

Visual Basic stellt keine speziellen Funktionen bereit, mit denen die Bezeichnung von Laufwerken ermittelt und gesetzt werden kann. Zum Bestimmen der Bezeichnung eines Laufwerks kann man jedoch einen Trick mit der Funktion Dir anwenden. Dir("C:\", vbVolume) würde beispielsweise die Bezeichnung des Laufwerks C: zurückgeben. Alternativ kann man auf die vom Betriebssystem bereitgestellte Funktion GetVolumeInformation zurückgreifen:

Private Declare Function GetVolumeInformation _
    Lib "kernel32.dll" _
    Alias "GetVolumeInformationA" _
( _
    ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, _
    ByRef lpVolumeSerialNumber As Long, _
    ByRef lpMaximumComponentLength As Long, _
    ByRef lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long _
) As Long

Private Function GetDriveName( _
    ByVal Drive As String, _
    ByRef DriveName As String _
) As Boolean
    Dim VolumeNameBuffer As String
    VolumeNameBuffer = Space$(256)
    GetDriveName = _
        ( _
            GetVolumeInformation( _
                Drive, _
                VolumeNameBuffer, _
                Len(VolumeNameBuffer), _
                0&, _
                0&, _
                0&, _
                vbNullString, _
                0& _
            ) <> 0& _
        )
    If GetDriveName Then
        DriveName = _
            Left$( _
                VolumeNameBuffer, _
                InStr(VolumeNameBuffer, vbNullChar) - 1 _
            )
    End If
End Function

Um die Bezeichnung eines Laufwerks zu setzen, kann die API-Funktion SetVolumeLabel benutzt werden. Die Kapselung in der Funktion SetDriveName erwartet im ersten Parameter den Pfad des Wurzelverzeichnisses des Laufwerks, dessen Bezeichnung geändert werden soll. Ein Beispielaufruf könnte Debug.Assert SetDriveName("C:\", "Windows XP") lauten: 

Private Declare Function SetVolumeLabel _
    Lib "kernel32.dll" _
    Alias "SetVolumeLabelA" _
( _
    ByVal lpRootPathName As String, _
    ByVal lpVolumeName As String _
) As Long

Private Function SetDriveName( _
    ByVal Drive As String, _
    ByVal NewName As String _
) As Boolean
    SetDriveName = (SetVolumeLabel(Drive, NewName) <> 0&)
End Function

Abschließen von Pfadangaben mit einem Backslash

Manchmal bekommt man unter Visual Basic von einer API-Funktion oder einer beliebigen anderen Funktion einen Pfad zurückgeliefert, an den ein Dateiname angehängt werden muß. Dazu ist eine Funktion notwendig, die das letzte Zeichen der Pfadangabe prüft und gegebenenfalls einen Backslash hinzufügt:

Private Function CheckBackslash(ByVal Path As String) As String
    CheckBackslash = Path
    If Right$(Path, 1) <> "\" Then
        CheckBackslash = CheckBackslash & "\"
    End If
End Function

Private Sub Main()
    Call MsgBox(CheckBackslash("C:\WINDOWS") & "Angler.bmp")
End Sub

Verschieben von Dateien

In Visual Basic werden Dateien mit der Anweisung FileCopy kopiert, für das Verschieben von Dateien stellt Visual Basic aber keine Funktion FileMove zur Verfügung. Um eine Datei zu verschieben, kann die Name-Funktion, die eigentlich zum Umbenennen von Dateien dient, verwendet werden. Wenn der Quell- und Zielpfad voneinander abweichen, dann wird die Datei auch verschoben. Viele Programmierer verschieben eine Datei durch Kopieren an den neuen Speicherort und anschließendes Löschen der alten Datei. Das funktioniert aber nicht, wenn beispielsweise eine 10 MB große Datei auf einem Laufwerk verschoben werden soll, wenn nur mehr 9 MB frei sind. Hier muß die Datei echt verschoben werden:

Name "C:\AUTOEXEC.BAT" As "A:\DATA\AUTOEXEC.001"

Ist eine Datei schreibgeschützt?

Bei der Frage, ob eine Datei schreibgeschützt ist, entscheidet nicht nur ihr Attribut (schreibgeschützt), sondern auch die Art des Datenträgers (z. B. CD-ROM-Laufwerk) oder die erteilten Rechte des Benutzers (etwa auf einem entsprechend konfigurierten NT-Benutzerkonto oder auf einem Netzwerklaufwerk).

Eine beliebte Möglichkeit der Überprüfung, ob tatsächlich in eine Datei geschrieben werden kann, ist daher die „Trial-and-Error“-Methode, die Datei durch einen Open-Befehl für das Schreiben zu öffnen. Gelingt dies nicht, ist die Datei offensichtlich schreibgeschützt. Der Nachteil dieser Methode ist, daß sich, wenn die Datei problemlos für das Schreiben geöffnet werden kann, ihr Zeitstempel ändert – ein Nebeneffekt, der für das Ermitteln dieser einfachen Information eigentlich nicht zu vertreten ist:

Man kann dieses Problem umgehen, indem man über das Windows-API die Dateizeiten der Datei ausliest und nach dem Versuch, in die Datei zu schreiben, wieder zuweist.

Zugriff auf Dateien im Netzwerk ohne Laufwerkszuweisung

Um im Netzwerk eine Dateizugriffe durchzuführen, müssen Sie nicht unbedingt ein Netzlaufwerk verbinden, es muß nur der Bereich, in dem der Dateizugriff erfolgen soll, freigegeben sein. Die gewünschte Datei kann dann folgendermaßen angesprochen werden:

Open "\\Servername\Dir\test.txt" For Output As #1
Print #1, "Ein Text"
Close #1

Dieser Code schreibt den Text Ein Text in die Datei test.txt; auf den Server mit dem Namen Servername in das Verzeichnis, das als dir freigegeben wurde. Anstelle von Servername könnte natürlich ein beliebiger Computername stehen (z. B. \\MyComputer).

Ermitteln des Dateititels einer Datei

Neben den Standarddialogfeldern für Öffnen, Speichern etc. ist in der ComDlg32.dll auch eine Funktion enthalten, die den Dateinamen einer Datei, wie er von der Shell angezeigt wird, ermittelt. Die beiden Parameter lpszTitle und cbBuf wurden von String in Long geändert:

Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" ( _
    ByVal lpszFile As String, _
    ByVal lpszTitle As String, _
    ByVal cbBuf As Long  _
) As Long

Private Sub Main()
    Call MsgBox(FileTitle("C:\AUTOEXEC.BAT"))
    Call MsgBox(FileTitle("C:\Programme"))
End Sub

Private Function FileTitle(ByVal FileName As String) As String
    Dim t As String
    Dim SizeNeeded As Long
    SizeNeeded = GetFileTitle(FileName, vbNullString, 0&)
    t = Space$(SizeNeeded + 1)
    
    ' 0 bedeutet erfolgreich.
    If GetFileTitle(FileName, t, Len(t) - 1) = 0 Then
        FileTitle = t
    End If
End Function

Prüfen zweier Dateien auf Gleichheit

Ab und zu ist es notwendig, zwei kleinere Dateien auf Gleichheit zu überprüfen. Dazu bietet sich die Funktion CompareSmallFiles an. Bei größeren Dateien sollten immer nur Teile einer bestimmten Größe gelesen und verglichen werden. Die Funktion prüft am Anfang, ob die Dateien gleich lang sind; ist dies nicht der Fall, können die Dateien nicht den gleichen Inhalt besitzen:

'
' Gibt zurück, ob die beiden Dateien gleich sind.
'
Private Function CompareSmallFiles( _
    ByVal FileName1 As String, _
    ByVal FileName2 As String _
) As Boolean
    If FileLen(FileName1) <> FileLen(FileName2) Then
        CompareSmallFiles = False
    Else
        Open FileName1 For Input As #1
        FileName1 = Input$(LOF(1), #1)
        Close #1
        Open FileName2 For Input As #2
        FileName2 = Input$(LOF(2), #2)
        Close #2
        CompareSmallFiles = (FileName1 = FileName2)
    End If
End Function

Trennen der Verbindung mit einem Netzlaufwerk

Um die Verbindung zu einem Netzlaufwerk zu trennen, kann der nachfolgende Code verwendet werden. Zu beachten ist dabei, daß der Laufwerksbuchstabe mindestens zwei Zeichen lang sein muß, also mit Doppelpunkt, ein Backslash, z. B. "E:\", ist auch erlaubt:

Private Declare Function WNetCancelConnection Lib "mpr.dll" _
    Alias "WNetCancelConnectionA" ( _
    ByVal lpszName As String, _
    ByVal bForce As Long _
) As Long

Private Sub Main()
    Call MsgBox("Trennen erfolgreich: " & CancelNetConnection)
End Sub

Private Function CancelNetConnection(ByVal Drive As String) As Boolean
    CancelNetConnection = (WNetCancelConnection(Drive, 1&) = 0)
End Function

Verbinden eines Netzlaufwerks mittels eines Dialogs

Folgender Code öffnet den Assistenten zum Verbinden zu einem Netzlaufwerk. Es wird keine Fehlerbehandlung durchgeführt:

Private Declare Function WNetConnectionDialog Lib "mpr.dll" ( _
    ByVal hWnd As Long, _
    ByVal dwType As Long _
) As Long

Private Const RESOURCETYPE_DISK As Long = 1&

Private Sub cmdConnect_Click()
    
    ' Da wir hier keine Auswertung machen, verwerfen wir den Rückgabewert.
    Call WNetConnectionDialog(Me.hWnd, RESOURCETYPE_DISK)
End Sub

Bestimmen des nächsten freien Laufwerks

Um dem nächsten Laufwerksbuchstaben zu ermitteln, der noch nicht belegt ist, bietet sich der im Folgenden angegebene Code an. Die Funktion NextFreeDrive gibt eine zwei Zeichen lange Zeichenfolge bestehend aus Laufwerksbuchstabe und Doppelpunkt zurück:

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" ( _
    ByVal nDrive As String _
) As Long

'
' Bestimmen des nächsten freien Laufwerks.
'
Private Function NextFreeDrive() As String
    Dim DriveNum As Long
    Dim FirstDrive As Long
    Dim NextDrive As String
    DriveNum = 1
    Do
        DriveNum = DriveNum + 1
        NextDrive = Chr$(DriveNum + 65) & ":\"
        FirstDrive = GetDriveType(NextDrive)
    Loop Until FirstDrive = 1
    
    ' Bedeutung von DriveNum: 2 = "C:\", 3 = "D:\", 4 = "E:\" usw.
    NextFreeDrive = Chr$(DriveNum + 65) & ":"
End Function

Private Sub Main()
    Call MsgBox("Nächstes freies Netzlaufwerk:  " & NextFreeDrive)
End Sub

Ermitteln des Kurznamens eines Pfades

Um den Kurznamen zu einem Pfad zu ermitteln, kann folgender Code verwendet werden:

Private Declare Function GetShortPathName _
    Lib "kernel32.dll" _
    Alias "GetShortPathNameA" _
( _
    ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal lBuffer As Long _
) As Long

Private Const MAX_PATH As Long = 260&

Private Sub Main()
    Call MsgBox(GetShortPath("C:\My Documents\Programming\Visual Basic"))
End Sub

Private Function GetShortPath(ByVal FileName As String) As String
    Dim n as Long, Temp As String
    Temp = Space$(MAX_PATH)
    n = GetShortPathName(FileName, Temp, MAX_PATH)
    
    ' Es ist ein Fehler aufgetreten.
    If n = 0& Then
        GetShortPath = FileName
    Else
        GetShortPath = Left$(Temp, n)
    End If
End Function

Der nachstehende Code erstellt eine Internetverknüpfung, d. h., eine Datei mit der Dateinamenerweiterung .url. Dazu werden die Visual-Basic-eigenen Funktionen für den Dateizugriff verwendet:

Private Sub Main()
    Const FileName As String = "C:\Sample.url"  
    If CreateWebLink(FileName, "https://dotnet.currifex.org/") = 0 Then
        Call MsgBox("Die Datei """ & FileName & """ wurde erfolgreich erstellt.")
    Else
        Call MsgBox("Es ist ein Fehler aufgetreten.")
    End If
End Sub

'
' Diese Funktion erstellt eine Internetverknüpfung und gibt bei Fehlern
' die Fehlernummer zurück.
'
Private Function CreateWebLink( _
    ByVal FileName As String, _
    ByVal UrlTarget As String _
) As Long
    On Error Resume Next
    Open FileName For Output As #1
    Print #1, "[InternetShortcut]"
    Print #1, "URL=" & UrlTarget
    Close #1  
    CreateWebLink = Err.Number
End Function

Setzen der Dateigröße ohne Neuschreiben der Datei

Ab und zu kommt es vor, daß man eine Datei kleiner machen will, als sie ist. Der naive Ansatz dazu ist, den Inhalt der Datei einzulesen, ihn zu verkleinern, dann die Originaldatei zu löschen und anschließend die Daten in eine neue Datei zu schreiben. Besonders bei großen Dateien erweist sich der Ansatz als nicht praktikabel: Wenn es sich um Dateien mehrerer Hundert Megabyte Größe handelt, dann kann man nämlich nicht einfach die Datei in den Arbeitsspeicher laden, sondern ist gezwungen, die Datei zu „zerteilen“ und dann blockweise zu kopieren. Erst dann kann die alte Datei gelöscht und durch die neue (z. B. durch Umbenennung) ersetzt werden:

Es wäre verwunderlich, wenn Windows zu diesem Zweck keine eigene API-Funktion bereitstellen würde. In diesem Fall haben wir Glück, die Funktion SetEndOfFile setzt das EOF, also das Dateiende, an die aktuelle Position, die man über SetFilePointer einstellen kann. Im Folgenden Beispiel wird eine Datei im Anwendungsverzeichnis geöffnet und ihre Dateilänge auf 12 Byte festgelegt:

Private Declare Function SetEndOfFile Lib "kernel32.dll" ( _
    ByVal hFile As Long _
) As Long

Private Declare Function OpenFile Lib "kernel32.dll" ( _
    ByVal lpFileName As String, _
    ByRef lpReOpenBuff As OFSTRUCT, _
    ByVal wStyle As Long _
) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long _
) As Long

Private Declare Function SetFilePointer Lib "kernel32.dll" ( _
    ByVal hFile As Long, _
    ByVal lDistanceToMove As Long, _
    ByRef lpDistanceToMoveHigh As Long, _
    ByVal dwMoveMethod As Long _
) As Long

Private Const OFS_MAXPATHNAME As Long = 128&
Private Const OF_CANCEL As Long = &H800&
Private Const OF_PROMPT As Long = &H2000&
Private Const OF_READWRITE As Long = &H2&
Private Const FILE_BEGIN As Long = 0&

Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Public Sub Main()
    Dim ofs As OFSTRUCT
    Dim hFile As Long
    Dim FileName As String
    FileName = App.Path
    If Right$(FileName, 1) <> "\" Then
        FileName = FileName & "\"
    End If
    FileName = FileName & "mytext.txt"
    
    ' Nehmen wir mal an, daß kein Fehler auftritt *g*.
    hFile = OpenFile(FileName, ofs, OF_PROMPT Or OF_CANCEL Or OF_READWRITE)
    If hFile <> -1 Then
        Call MsgBox("File length: " & FileLen(FileName) & " Bytes.")
        
        ' Setzen der Dateilänge auf 12 Bytes.
        Call SetFilePointer(hFile, 12&, 0&, FILE_BEGIN)
        Call SetEndOfFile(hFile)
        
        ' Ausgabe der neuen Dateilänge.
        Call MsgBox("File length: " & FileLen(FileName) & " Bytes.")
        Call CloseHandle(hFile)
    Else
        Call MsgBox("Error opening file.")
    End If
End Sub

Effizientes Ablegen eines Arrays in einer Datei

Wenn man Daten in einem Array ablegt, will man diese eventuell beim Beenden des Programms nicht „wegwerfen“, sondern in eine Datei speichern. Intuitiv würde man über Schleifen eine Zeichenfolge zusammenstellen, die den Inhalt der Elemente des Arrays enthält, und diesen anschließend in die Datei speichern. Der Aufwand dafür ist hoch und die Performanz des Programms leidet darunter stark. Stattdessen kann man sich auch der beiden Befehle Put und Get bedienen. Mit Put kann ein Array „auf einen Schlag“ persistent gemacht werden, Get liest es wiederum aus der Datei und weist es einer Arrayvariablen zu:

Dim a(0 To 4, 0 To 10) As Integer
Dim i As Long, j As Long

' Erstellen eines Arrays mit Zufallszahlen.
For i = 0 To UBound(a, 1)
    For j = 0 To UBound(a, 2)
        a(i, j) = CInt(Rnd * 1000)
    Next j
Next i

Dim FileName As String
FileName = App.Path
If Right$(FileName, 1) <> "\" Then
    FileName = FileName & "\"
End If
FileName = FileName & "meinedaten.txt"

' Schreiben des Arrays in eine Binärdatei.
Open FileName For Binary Access Write As #1
Put #1, 1, a
Close #1

' Löschen des Arrays im Arbeitsspeicher.
Erase a

' Einlesen der gespeicherten Daten in das Feld.
Open FileName For Binary Access Read As #1
Get #1, 1, a
Close #1

' Anzeige der gelesenen Daten.
For i = 0 To UBound(a, 1)
    For j = 0 To UBound(a, 2)
        Debug.Print a(i, j)
    Next j
Next i

Anzeigen des Dialogs zum Suchen nach Dateien mittels DDE

Folgender Code zeigt den betriebssystemeigenen Dialog zum Suchen nach Dateien bzw. Ordnern an. Dazu muß ein DDE-fähiges Steuerelement auf dem Formular plaziert werden; die Anzeige erfolgt dann beispielsweise über folgenden Code:

With Me.Text1
    .LinkTopic = "Folders|AppProperties"
    .LinkMode = vbLinkManual
    Call .LinkExecute("[FindFolder(""C:\"")]")  ' "Suchen"-Dialog anzeigen.
End With

Protokollieren von Programmaufrufen

Manchmal will man ein Protokoll aller Anwendungsstarts erstellen, um so beispielsweise zu ermitteln, welche Anwendungen beim Start von Windows ausgeführt werden bzw. um zu ermitteln, welche Anwendungen von einem Benutzer gestartet werden. Dies ist mit reinen Visual-Basic-Mitteln natürlich nicht möglich, allerdings kann man das Verhalten durch Ändern einiger Schlüssel in der Systemregistrierung erzielen. Dadurch ist es auch möglich, den Start von EXE-, LNK-, PIF, BAT- und COM-Dateien gegebenenfalls zu unterbinden. Für das Starten der Anwendung ist nämlich das in Visual Basic 6.0 entwickelte Programm zuständig, das in die Befehlszeile jene des zu startenden Programms hereingereicht bekommt.

In der Systemregistrierung müssen die folgenden Anpassungen vorgenommen werden (wir nehmen dabei an, daß die Anwendung in C:\ExeWrap.exe abgelegt ist):

Schlüssel HKEY_CLASSES_ROOT\exefile\shell\open\command
Neuer Wert: "C:\ExeWrap.exe" "%1" %*.
Schlüssel HKEY_CLASSES_ROOT\lnkfile\shell\open\command
Neuer Wert: "C:\ExeWrap.exe" "%1" %*.
Schlüssel HKEY_CLASSES_ROOT\piffile\shell\open\command
Neuer Wert: "C:\ExeWrap.exe" "%1" %*.
Schlüssel HKEY_CLASSES_ROOT\batfile\shell\open\command
Neuer Wert: "C:\ExeWrap.exe" "%1" %*.
Schlüssel HKEY_CLASSES_ROOT\comfile\shell\open\command
Neuer Wert: "C:\ExeWrap.exe" "%1" %*.

Die Anwendung selbst besteht aus wenigen Zeilen Code:

Private Sub Main()
    Dim CommandLine As String
    CommandLine = Command$
    Dim AppPath As String
    AppPath = App.Path
    If Right$(App.Path, 1) <> "\" Then
        AppPath = AppPath & "\"
    End If
    If Len(CommandLine) > 0 Then
        Open AppPath & "exelog.txt" For Append As #1
        Print #1, CommandLine & " " & CStr(Now)
        Close #1
        
        ' Diese Liste enthält Programme, die nicht ausgeführt werden "dürfen".
        If _
            InStr(1, CommandLine, "duke3d.exe") > 0 Or _
            InStr(1, CommandLine, "winmine.exe") > 0 _
        Then
            Call MsgBox( _
                "Sie sind nicht berechtigt, die Datei " & _
                Trim$(CommandLine) & _
                " auszuführen!", _
                vbExclamation, _
                App.Title _
            )
        Else
            Call Shell(CommandLine, vbNormalFocus)
        End If
    End If
End Sub

Kopieren einer Diskette über den Windows-eigenen Dialog

Die im nächsten Listing angegebene Prozedur CopyDisk ruft den Windows-eigenen Dialog zum Kopieren von Disketten auf, wobei das angegebene Laufwerk im Dialog voreingestellt wird. Handelt es sich beim übergebenen Laufwerk nicht um ein Diskettenlaufwerk, wird ein Fehler ausgelöst:

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" ( _
    ByVal nDrive As String _
) As Long

Private Const DRIVE_REMOVABLE As Long = 2&

Private Sub Main()
    On Error Resume Next
    Call CopyDisk("A")
    If Err.Number <> 0 Then
        Call MsgBox( _
            "Fehler " & CStr(Err.Number) & ": " & _
            Err.Description, _
            vbExclamation, _
            App.Title _
        )
        Call Err.Clear
    End If
End Sub

'
' 'DriveLetter' ist ein ein Zeichen langer String.
'
Private Sub CopyDisk(ByVal DriveLetter As String)
    
    ' DriveNumber ist die Nummer des zu kopierenden Laufwerks.
    ' Laufwerk A = 0, Laufwerk B = 1 usw.
    Dim DriveNumber As Long
    DriveNumber = Asc(UCase$(DriveLetter)) - Asc("A")
    
    ' Wenn Laufwerk ein Diskettenlaufwerk.
    If GetDriveType(DriveLetter & ":") = DRIVE_REMOVABLE Then
        Call Shell( _
            "rundll32.exe diskcopy.dll,DiskCopyRunDll " & _
            CStr(DriveNumber) & "," _
            & CStr(DriveNumber), _
            vbNormalFocus _
        )
    Else
        Call Err.Raise( _
            vbObjectError + 1, _
            , _
            "Nur Diskettenlaufwerke können kopiert werden." _
        )
    End If
End Sub

Ermitteln der Seriennummer eines Datenträgers

Die Funktionsprozedur GetSerialNumber gibt die Seriennummer eines Datenträgers als 32-Bit-Ganzzahl zurück:

Private Declare Function GetVolumeInformation _
    Lib "kernel32.dll" _
    Alias "GetVolumeInformationA" _
( _
    ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, _
    ByRef lpVolumeSerialNumber As Long, _
    ByRef lpMaximumComponentLength As Long, _
    ByRef lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long _
) As Long

Private Const MAX_FILENAME_LEN As Long = 256&

Private Sub Main()
    Call MsgBox( _
        "Seriennummer von Laufwerk ""C:""  " & CStr(GetSerialNumber("C:\")) _
    )
End Sub

Private Function GetSerialNumber(ByVal Drive As String) As Long
    Dim SerialNumber As Long
    Dim Temp1 As String, Temp2 As String
    Temp1 = String$(MAX_FILENAME_LEN, vbNullChar)
    Temp2 = String$(MAX_FILENAME_LEN, vbNullChar)
    Call GetVolumeInformation( _
        Drive, _
        Temp1, _
        Len(Temp1), _
        SerialNumber, _
        0&, _
        0&, _
        Temp2, _
        Len(Temp2) _
    )
    GetSerialNumber = SerialNumber
End Function

Ermitteln der verfügbaren Laufwerke und ihres Typs

Folgender Code gibt die Laufwerksbuchstaben der vorhandenen Laufwerke sowie deren Typ auf das Direktfenster aus. Dazu wird zuerst mit der API-Funktion GetLogicalDriveStrings eine Zeichenfolge ermittelt, die alle Laufwerksbuchstaben getrennt durch Nullzeichen beinhaltet. Anschließend wird diese Zeichenfolge aufgespaltet und mit der API-Funktion GetDriveType der Typ des jeweiligen Laufwerks bestimmt:

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" ( _
    ByVal nDrive As String _
) As Long

Private Declare Function GetLogicalDriveStrings _
    Lib "kernel32.dll" _
    Alias "GetLogicalDriveStringsA" _
( _
    ByVal nBufferLength As Long, _
    ByVal lpBuffer As String _
) As Long

Private Const DRIVE_UNKNOWN As Long = 0&
Private Const DRIVE_NO_ROOT_DIR As Long = 1&
Private Const DRIVE_REMOVABLE As Long = 2&
Private Const DRIVE_FIXED As Long = 3&
Private Const DRIVE_REMOTE As Long = 4&
Private Const DRIVE_CDROM As Long = 5&
Private Const DRIVE_RAMDISK As Long = 6&

Private Sub Main()
    Call EnumDrives
End Sub

Private Sub EnumDrives()
    Dim n As Long, DriveType As Long
    Dim Buffer As String, Drive As String, s As String
    Buffer = Space$(64)
    n = GetLogicalDriveStrings(Len(Buffer), Buffer)
    Dim Drives() As String
    Drives = Split(Left$(Buffer, n - 1), vbNullChar)
    For n = 0 To UBound(Drives)
        Drive = Drives(n)
        DriveType = GetDriveType(Drive)
        Select Case DriveType
            Case DRIVE_UNKNOWN
                s = "Unbekannt"
            Case DRIVE_NO_ROOT_DIR
                s = "Kein Rootlaufwerk"
            Case DRIVE_REMOVABLE
                s = "Wechseldatenträger"
            Case DRIVE_FIXED
                s = "Festplatte"
            Case DRIVE_REMOTE
                s = "Netzlaufwerk"
            Case DRIVE_CDROM
                s = "CD-ROM"
            Case DRIVE_RAMDISK
                s = "RAM-Disk"
        End Select
        
        ' Gefundenes Laufwerk ausgeben.
        Debug.Print UCase(Mid$(Drive, 1, 2)) & vbTab & s
    Next n
End Sub