Audio Codecs aufzählen Sucht nach ACM (Audio Compression Manager) Codecs
Autor:   [rm_code]	Bewertung:     [ Jetzt bewerten ]	Views:  12.886
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 10 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.9 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Dieser Tipp sucht nach auf dem System installierten Audio Codecs, mit Hilfe des ACM (Audio Compression Manager). Die gefundenen Codecs werden in die Struktur acmDrivers gespeichert, mitsamt den vom Codec unterstützten Formaten.

Einfach folgenden Code in ein Modul schreiben:

Option Explicit
 
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
 
Private Declare Function acmMetrics Lib "msacm32" ( _
  ByVal hao As Long, _
  ByVal uMetric As Integer, _
  pMetric As Any) As Long
 
Private Declare Function acmDriverEnum Lib "msacm32" ( _
  ByVal fnCallback As Long, _
  dwInstance As Long, _
  ByVal fdwEnum As Long) As Long
 
Private Declare Function acmDriverDetails Lib "msacm32" _
  Alias "acmDriverDetailsA" ( _
  ByVal hadid As Long, _
  padd As TACMDRIVERDETAILS, _
  ByVal fdwDetails As Long) As Long
 
Private Declare Function acmDriverOpen Lib "msacm32" ( _
  ByRef phad As Long, _
  ByVal hadid As Long, _
  ByVal fdwOpen As Long) As Long
 
Private Declare Function acmDriverClose Lib "msacm32" ( _
  ByVal had As Long, _
  ByVal fdwClose As Long) As Long
 
Private Declare Function acmFormatEnum Lib "msacm32" _
  Alias "acmFormatEnumA" ( _
  ByVal had As Long, _
  ByRef pafd As ACMFORMATDETAILS, _
  ByVal fnCallback As Long, _
  ByRef dwInstance As Long, _
  ByVal fdwEnum As Long) As Long
 
Private Declare Function acmFormatTagDetails Lib "msacm32" _
  Alias "acmFormatTagDetailsA" ( _
  ByVal had As Long, _
  paftd As TACMFORMATTAGDETAILS, _
  ByVal fdwDetails As Long) As Long
 
Private Declare Function acmGetVersion Lib "msacm32" () As Long
 
Public Type TWAVEFORMATEX
  wFormatTag                  As Integer
  nChannels                   As Integer
  nSamplesPerSec              As Long
  nAvgBytesPerSec             As Long
  nBlockAlign                 As Integer
  wBitsPerSample              As Integer
  cbSize                      As Integer
  xBytes(11)                  As Byte
End Type
 
Private Type ACMFORMATDETAILS
  cbStruct                    As Long
  dwFormatIndex               As Long
  dwFormatTag                 As Long
  fdwSupport                  As Long
  pwfx                        As Long
  cbwfx                       As Long
  szFormat                    As String * 128
End Type
 
Private Type TACMDRIVERDETAILS
  cbStruct                    As Long
  fccType(3)                  As Byte
  fccComp(3)                  As Byte
  wMid                        As Integer
  wPid                        As Integer
  vdwACM                      As Long
  vdwDriver                   As Long
  fdwSupport                  As Long
  cFormatTags                 As Long
  cFilterTags                 As Long
  hIcon                       As Long
  szShortname                 As String * 32
  szLongName                  As String * 128
  szCopyright                 As String * 80
  szLicensing                 As String * 128
  szFeatures                  As String * 512
End Type
 
Private Type TACMFORMATTAGDETAILS
  cbStruct                    As Long
  dwFormatTagIndex            As Long
  dwFormatTag                 As Long
  cbFormatSize                As Long
  fdwSupport                  As Long
  cStandardFormats            As Long
  szFormatTag                 As String * 48
End Type
 
Private Const WAVE_FORMAT_UNKNOWN        As Long = &H0
Private Const ACM_METRIC_MAX_SIZE_FORMAT As Long = &H32
 
Public Type FormatTag
  FormatTagIndex              As Long
  FormatTag                   As Long
  szFormat                    As String
  wfx                         As TWAVEFORMATEX
End Type
 
Public Type acmDriver
  LongName                    As String
  ShortName                   As String
  Copyright                   As String
  Licensing                   As String
  Features                    As String
  FormatTagCount              As Integer
  FormatTag()                 As FormatTag
End Type
 
Public Type drivers
  count                       As Integer
  drivers()                   As acmDriver
End Type
 
Public acmDrivers               As drivers
 
Private lngPower2(31)           As Long

' Audio Compression Manager Version
Public Function ACMVersion() As String
  Dim major       As Integer
  Dim revision    As Integer
  Dim build       As Integer
  Dim ACMVer      As Long
 
  ACMVer = acmGetVersion
 
  major = RShift(((ACMVer And &HFFFF0000) / &H10000), 8)
  revision = ((ACMVer And &HFFFF0000) / &H10000) And &HFF
  build = ACMVer And &HFFFF&
 
  If build = 0 Then ACMVersion = " Retail"
 
  ACMVersion = major & "." & format$(revision, "00") & _
    " Build " & build & ACMVersion
End Function

' Codecs aufzählen
Public Sub ListCodecs()
  Dim mmr     As Long
 
  mmr = acmDriverEnum(AddressOf acmDriverEnumCallback, 0, 0)
End Sub

' Rückruffunktion für die Treiberaufzählung
Private Function acmDriverEnumCallback(ByVal haid As Long, _
  ByVal dwInstance As Long, _
  ByVal fdwSupport As Long) As Long
 
  Dim fmtTagDetails  As TACMFORMATTAGDETAILS
  Dim fmtDetails  As ACMFORMATDETAILS
  Dim wavformat   As TWAVEFORMATEX
  Dim details     As TACMDRIVERDETAILS
  Dim i           As Integer
  Dim MaxSize     As Long
  Dim driver      As Long
  Dim mmr         As Long
 
  ' Treiberhandle
  driver = 0
  mmr = acmDriverOpen(driver, haid, 0)
 
  ' Treiberdetails lesen
  details.cbStruct = Len(details)
  mmr = acmDriverDetails(haid, details, 0)
 
  ReDim Preserve acmDrivers.drivers(acmDrivers.count) As acmDriver
 
  With acmDrivers.drivers(acmDrivers.count)
    .LongName = TrimNull(details.szLongName)
    .ShortName = TrimNull(details.szShortname)
    .Copyright = TrimNull(details.szCopyright)
    .Licensing = TrimNull(details.szLicensing)
    .Features = TrimNull(details.szFeatures)
  End With
 
  ' mögliche Format Tags abarbeiten
  For i = 0 To details.cFormatTags - 1
 
    ' Details zum aktuellen Format Tag lesen
    fmtTagDetails.cbStruct = Len(fmtTagDetails)
    fmtTagDetails.dwFormatTagIndex = i
 
    mmr = acmFormatTagDetails(driver, fmtTagDetails, 0)
 
    ' ... dann eine Enumeration der unterstützten
    ' Formate vorbereiten
    wavformat.cbSize = Len(wavformat)
    wavformat.wFormatTag = WAVE_FORMAT_UNKNOWN
 
    ' größte Größe von WaveFormatEx bestimmen
    acmMetrics driver, ACM_METRIC_MAX_SIZE_FORMAT, MaxSize
    If MaxSize < Len(wavformat) Then MaxSize = Len(wavformat)
 
    wavformat.cbSize = (MaxSize And &HFFFF&) - Len(wavformat)
    wavformat.wFormatTag = WAVE_FORMAT_UNKNOWN
 
    fmtDetails.cbStruct = Len(fmtDetails)
    fmtDetails.pwfx = VarPtr(wavformat)
    fmtDetails.cbwfx = MaxSize
    fmtDetails.dwFormatTag = WAVE_FORMAT_UNKNOWN
 
    ' Formate aufzählen
    mmr = acmFormatEnum(driver, fmtDetails, _
      AddressOf acmFormatCallback, 0, 0)
  Next
 
  ' Treiber schließen
  mmr = acmDriverClose(driver, 0)
 
  acmDrivers.count = acmDrivers.count + 1
 
  ' 1 (true) zurückgeben für nächsten Treiber,
  ' 0, um acmDriverEnum abzubrechen
  acmDriverEnumCallback = 1
End Function

' Rückruffunktion für die Formataufzählung
Private Function acmFormatCallback(ByVal hACMDriverID As Long, _
  ByRef ACMFmtDet As ACMFORMATDETAILS, _
  ByVal dwInstance As Long, _
  ByVal fdwSupport As Long) As Long
 
  Dim format As TWAVEFORMATEX
 
  ' 1 (true) zurückgeben für nächstes Format,
  ' 0, um acmFormatCallback abzubrechen
  acmFormatCallback = 1
 
  ' Daten von WaveFormatEx Pointer in wavformat kopieren
  CopyMemory format, ByVal ACMFmtDet.pwfx, Len(format)
 
  ' Format speichern
  With acmDrivers.drivers(acmDrivers.count)
    ReDim Preserve .FormatTag(.FormatTagCount) As FormatTag
 
    With .FormatTag(.FormatTagCount)
      .wfx = format
      .szFormat = TrimNull(StrConv(ACMFmtDet.szFormat, vbUnicode))
      .FormatTag = ACMFmtDet.dwFormatTag
      .FormatTagIndex = ACMFmtDet.dwFormatIndex
    End With
 
  End With
 
  With acmDrivers.drivers(acmDrivers.count)
    .FormatTagCount = .FormatTagCount + 1
  End With
End Function

' Null Chars abschneiden
Private Function TrimNull(strVal As String) As String
  TrimNull = Trim$(Left$(strVal, InStr(strVal, Chr$(0)) - 1))
End Function

' Bits eines Longs nach rechts verschieben
' von VB Accelerator
Private Function RShift(ByVal lThis As Long, ByVal lBits As Long) As Long
  Static init As Boolean
 
  If Not init Then InitShifting: init = True
 
  If (lBits <= 0) Then
    RShift = lThis
  ElseIf (lBits > 63) Then
    Exit Function
  ElseIf (lBits > 31) Then
    RShift = 0
  Else
    If (lThis And lngPower2(31)) = lngPower2(31) Then
      RShift = (lThis And &H7FFFFFFF) \ lngPower2(lBits) Or lngPower2(31 - lBits)
    Else
      RShift = lThis \ lngPower2(lBits)
    End If
  End If
End Function

' 2er Potenzen fürs Shifting
' von VB Accelerator
Private Sub InitShifting()
  lngPower2(0) = &H1&: lngPower2(1) = &H2&
  lngPower2(2) = &H4&: lngPower2(3) = &H8&
  lngPower2(4) = &H10&: lngPower2(5) = &H20&
  lngPower2(6) = &H40&: lngPower2(7) = &H80&
  lngPower2(8) = &H100&: lngPower2(9) = &H200&
  lngPower2(10) = &H400&: lngPower2(11) = &H800&
  lngPower2(12) = &H1000&: lngPower2(13) = &H2000&
  lngPower2(14) = &H4000&: lngPower2(15) = &H8000&
  lngPower2(16) = &H10000: lngPower2(17) = &H20000
  lngPower2(18) = &H40000: lngPower2(19) = &H80000
  lngPower2(20) = &H100000: lngPower2(21) = &H200000
  lngPower2(22) = &H400000: lngPower2(23) = &H800000
  lngPower2(24) = &H1000000: lngPower2(25) = &H2000000
  lngPower2(26) = &H4000000: lngPower2(27) = &H8000000
  lngPower2(28) = &H10000000: lngPower2(29) = &H20000000
  lngPower2(30) = &H40000000: lngPower2(31) = &H80000000
End Sub

Folgende kleine Demo gibt alle Codecs im Direktfenster aus:

Dim i As Long
Debug.Print "ACM Version: " & ACMVersion
Debug.Print "######################################################"
 
ListCodecs
For i = 0 To acmDrivers.count - 1
  With acmDrivers.drivers(i)
    Debug.Print "Codec Name: " & .LongName
    Debug.Print "Copyright: " & .Copyright
    Debug.Print "Lizenz: " & .Licensing
    Debug.Print "Features: " & .Features
    Debug.Print "######################################################"
  End With
Next i

Dieses Beispiel sucht nach MP3 Codecs:

Dim i As Long, j As Long
Const WAVE_FORMAT_MPEG3 As Long = &H55
 
ListCodecs
For i = 0 To acmDrivers.count - 1
  With acmDrivers.drivers(i)
    For j = 0 To .FormatTagCount - 1
      If .FormatTag(j).FormatTag = WAVE_FORMAT_MPEG3 Then
        Debug.Print "MP3 Codec gefunden: " & .LongName
        Exit For
      End If
    Next j
  End With
Next i

Mit acmDrivers(Treiberindex).FormatTag(FormatTagIndex).szFormat kann man sich übrigens eine formatierte Beschreibung des jeweiligen Format Tags ausgeben lassen.