P°ehrßvßnφ pouze zvukovΘ stopy AVI souboru

Postup:
Do deklaraΦnφ Φßsti formulß°e zapiÜte:

Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm" Alias _
    "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
    ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias _
    "GetShortPathNameA" (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Sub PlayAVIVideoOFF(FileName As String)

    Dim RetVal As Long
    Dim CommandString As String
    Dim ShortFileName As String * 260
    Dim deviceIsOpen As Boolean

    RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
    FileName = Left$(ShortFileName, RetVal)
    
    CommandString = "Open " & FileName & " type avivideo alias AVIFile"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal Then GoTo error
    
    deviceIsOpen = True
    
    CommandString = "Set AVIFile video off"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal Then GoTo error
    
    CommandString = "Play AVIFile wait"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal Then GoTo error
    
    CommandString = "Close AVIFile"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal Then GoTo error

    Exit Sub
    
error:
    Dim ErrorString As String
    ErrorString = Space$(256)
    mciGetErrorString RetVal, ErrorString, Len(ErrorString)
    ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)

    If deviceIsOpen Then
        CommandString = "Close AVIFile"
        mciSendString CommandString, vbNullString, 0, 0&
    End If

    Err.Raise 999, , ErrorString

End Function

Zp∞t