Private Const BIN_GETBINSTRING = 109
Private Const BIN_LENBINSTRING = 8
 
Private Sub Command1_Click()
    Dim sPath   As String
    Dim sRes    As String
 
    sPath = Text1
    If sPath = vbNullString Then Label1 = vbNullString: Exit Sub
    sRes = fGetAviCodec(sPath)
    If Mid$(sRes, 5, 1) = Chr(0) Then
        Label1 = "Kein CODEC vorhanden"
    Else
        Label1 = "Verwendeter Codec : " & UCase(Right$(sRes, 4))
    End If
    sPath = Empty: Text1 = vbNullString
End Sub
 
 
Private Function fGetAviCodec(ByVal sPath As String) As String
    Dim ifno            As Integer
    Dim sAviCodec       As String
 
    If sPath = vbNullString Then Exit Function
 
    ifno = FreeFile
    Open sPath For Binary As ifno
        sAviCodec = String(BIN_LENBINSTRING, " ")
        Get #ifno, BIN_GETBINSTRING, sAviCodec
        fGetAviCodec = sAviCodec
    Close ifno
End Function
 
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
 
Private Sub Drive1_Change()
    On Error Resume Next
    Dir1.Path = Drive1.Drive
    If Err = 0 Then
        Drive1.Drive = Dir1.Path
    End If
End Sub
 
Private Sub File1_Click()
    Dim sPath           As String
    Dim sComplettePath  As String
 
    On Error Resume Next
    sPath = Dir1.Path
    If Right$(sPath, 1) <> "\" Then
        sPath = sPath + "\"
    End If
 
    sComplettePath = (sPath + File1.FileName)
    Text1 = sComplettePath
End Sub
 
Private Sub Form_Load()
    File1.Pattern = "*.avi"
    ChDir App.Path
    Drive1_Change
End Sub