Tipp 0023 Seriennummer & Datenträgerbezeichnung auslesen
Autor/Einsender:
Datum:
  Detlev Schubert
17.04.2001
Entwicklungsumgebung:   VB 5
Mit der sehr umfangreichen API-Funktion GetVolumeInformation ist es möglich die Seriennummer und die Datenträgerbezeichnung eines Datenträgers zu erhalten.
Code im Codebereich des Moduls
 
Option Explicit

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

Public Function LwSerialNumber(Lw As String) As String
  Dim FileSystem As String
  Dim SerNum As Long
  Dim MaxLen As Long
  Dim Flags As Long
  Dim VolSize As Long
  Dim VolLabel As String
  Dim SerialNumber As String

  Lw = LCase$(left$(Lw, 1))

  If Lw = "\" Then
    Exit Function
  Else
    Lw = Lw & ":\"
  End If

  FileSystem = Space$(256)
  If GetVolumeInformation(Lw, VolLabel, VolSize, SerNum, _
          MaxLen, Flags, FileSystem, Len(FileSystem)) <> 0 Then

    SerialNumber = Trim(Hex(SerNum))
    SerialNumber = _
          String(8 - Len(SerialNumber), "0") & SerialNumber
    SerialNumber = _
          left$(SerialNumber, 4) & "-" & right$(SerialNumber, 4)

    LwSerialNumber = SerialNumber
  Else
    LwSerialNumber = "- keine -"
  End If
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Drive1_Change()
  Dim VolumeSerialNumber As Long
  Dim VolumeNameBuffer As String
  Dim MaximumComponentLength As Long
  Dim FileSystemFlags As Long
  Dim FileSystemNameBuffer As String

  VolumeNameBuffer = Space(256)
  FileSystemNameBuffer = Space(256)

  GetVolumeInformation left(Drive1.Drive, 1) & ":\", _
        VolumeNameBuffer, Len(VolumeNameBuffer), _
        VolumeSerialNumber, MaximumComponentLength, _
        FileSystemFlags, FileSystemNameBuffer, _
        Len(FileSystemNameBuffer)

  If left$(VolumeNameBuffer, 1) = Chr(0) Then
    Label1(1).Caption = "- keine -"
  Else
    Label1(1).Caption = VolumeNameBuffer
  End If

  Label1(3).Caption = LwSerialNumber(Drive1.Drive)
End Sub
 
Weitere Links zum Thema
Laufwerks-Informationen ermitteln (FSO)
Laufwerksbezeichnung ändern / setzen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,4 kB) Downloads bisher: [ 3145 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 25. September 2011