mciSendString-Funktion Diese Funktion sendet an einen MCI-Gerätetreiber ein Kommando um z.B. eine Multimedia-Datei abzuspielen, die Wiedergabe zu stoppen oder Informationen zu einem Gerät oder einer Multimedia-Datei zu ermitteln.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  33.758

Deklaration:

Declare Function mciSendString Lib "winmm.dll" _
  Alias "mciSendStringA" ( _
  ByVal lpszCommand As String, _
  ByVal lpszReturnString As String, _
  ByVal cchReturnLength As Long, _
  ByVal hwndCallback As Long) As Long

Beschreibung:
Diese Funktion sendet an einen MCI-Gerätetreiber ein Kommando um z.B. eineMultimedia-Datei abzuspielen, die Wiedergabe zu stoppen oder Informationen zu einem Gerät oder einerMultimedia-Datei zu ermitteln.

Parameter:

lpszCommand	Erwartet das Kommando, das an dem im String selbstdefinierten MCI-Treiber geschickt werden soll.
lpszReturnString	Erwartet einen Puffer, der mit Leerzeicheninitialisiert ist, um das Ergebnis des Aufrufs zu bekommen.
cchReturn	Erwartet die Größe des Puffers in Bytes.
hwndCallback	Wenn in dem Kommandostring "Notify" eingeschaltet wurde, muss man hierdas Handle des Fensters übergeben, das die Ereignisse des MCI-Treiber empfangen soll.

Rückgabewert:
Ist die Funktion erfolgreich, so ist die Rückgabe "0", andernfalls ist die Rückgabe ein Fehlercode. Für erweiterte Fehlerinformationen rufenSie die mciGetErrorString-Funktion mit dem erhaltenen Fehlercode auf.

Beispiel:

' Schreiben Sie den folgenden Code in ein öffentliches Modul
Private Declare Function GetProfileString Lib "kernel32" _
  Alias "GetProfileStringA" ( _
  ByVal lpAppName As String, _
  ByVal lpKeyName As String, _
  ByVal lpDefault As String, _
  ByVal lpReturnedString As String, _
  ByVal nSize As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" _
  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.dll" _
  Alias "mciGetErrorStringA" ( _
  ByVal dwError As Long, _
  ByVal lpstrBuffer As String, _
  ByVal uLength As Long) As Long
Private Declare Function GetShortPathNameA Lib "kernel32" ( _
  ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, _
  ByVal cchBuffer As Long) As Long
 
' die MCISendString Callback Konstanten
Private Const MM_MCINOTIFY = &H3B9 ' wird an die Standard Fensterprozedur geschickt  
' falls bei Ereignissen
Private Const MCI_NOTIFY_ABORTED = &H4 ' Wiedergabe wurde abgebrochen
Private Const MCI_NOTIFY_FAILURE = &H8 ' ein Fehler ist beim Aufruf aufgetreten
Private Const MCI_NOTIFY_SUCCESSFUL = &H1 ' der Befehl wurde erfolgreich ausgeführt
Private Const MCI_NOTIFY_SUPERSEDED = &H2 ' ein anderes Gerät bekommt die  
' Nachrichten, das eigene Programm wird nicht mehr benachrichtigt
 
 
Private OpenAlias As Boolean
Private Const StdAlias = "TmpAlias"

' ermitteln aller Dateitypen, die mit den MCI-Treibern abgespielt werden sollen
Public Function GetMciFileTypes() As String
  Dim Retval As String, Buffer As String * 255, FileTypes As Variant
 
  ' erst mal alle Dateitypen ermitteln
  Retval = GetProfileString("mci extensions", vbNullString, "*.*" & vbNullChar,  _
  Buffer, Len(Buffer))
  FileTypes = Split(Left$(Buffer, Retval), vbNullChar)
 
  ' jetzt die dazugehörigen Treiber identifizieren
  GetMciFileTypes = GetMciFileTypes & "*.* - Alle Dateien" & vbNullChar & "*.*"  _
  & vbNullChar
  For i = 0 To UBound(FileTypes) - 1
    Buffer = Space(256)
    Retval = GetProfileString("mci extensions", FileTypes(i), "" &  _
    vbNullChar, Buffer, Len(Buffer))
    GetMciFileTypes = GetMciFileTypes & "*." & FileTypes(i) & " - " &  _
    Left$(Buffer, Retval) & vbNullChar & "*." & FileTypes(i) & vbNullChar
  Next i
 
  ' und als String zurückgeben, so dass der CommonDialog diesen gleich verwenden kann 
  GetMciFileTypes = GetMciFileTypes & vbNullChar
End Function

' ermitteln eines Treibers für einen entsprechenden Dateityp
Private Function GetSingleType(ByVal Extension As String) As String
  Dim Retval As String, Buffer As String * 255
 
  Retval = GetProfileString("mci extensions", Right$(Extension, 3), "NotFound" &  _
  vbNullChar, Buffer, Len(Buffer))
  GetSingleType = Left$(Buffer, Retval)
End Function

' Fehlercode für einen erfolglosen Aufruf ermitteln
Private Function ErrMsg(ByVal Errorcode As Long)
  Dim Retval As String, Buffer As String * 256
 
  ' kein Fehler
  If Errorcode = 0 Then Exit Function
 
  ' Fehler in einer MessageBox ausgeben
  Retval = mciGetErrorString(Errorcode, Buffer, Len(Buffer))
  MsgBox Left$(Buffer, InStr(1, Buffer, vbNullChar) - 1), vbCritical +  _
  vbInformation, "Fehler " & CStr(Errorcode)
End Function

' öffnet eine Datei, sofern nicht eine andere noch geöffnet ist
Public Function Mci_Open(ByVal FileName As String)
  Dim Buffer As String * 256
 
  If OpenAlias Then
    Mci_Close
  End If
  OpenAlias = True
 
  ' ermittelt den Dos-Pfadnamen, ist erforderlich weil MCI Treiber Leerstellen  
  ' als Separator interpretieren
  Retval = GetShortPathNameA(FileName, Buffer, Len(Buffer))
  FileName = Left$(Buffer, Retval)
 
  ' öffnet ein Gerät und eine Multimedia-Datei
  ErrMsg mciSendString("open " & FileName & " type " & GetSingleType(FileName) &  _
  " alias " & StdAlias, 0, 0, 0)
 
  ' falls das Medium ein Video ist, die PictureBox als Anzeige verwenden
  mciSendString "window " & StdAlias & " handle " &  _
  CStr(Player_frm.Picture1.hWnd), 0, 0, 0
 
  ' Zeitformat wählen, das wir abfragen wollen
  mciSendString "Set " & StdAlias & " Time Format Milliseconds", 0, 0, 0
End Function

' schließen eines MCI-Treibers
Public Function Mci_Close()
  If Not OpenAlias Then Exit Function
  mciSendString "close " & StdAlias, 0, 0, 0
  OpenAlias = False
End Function

' starten der Wiedergabe von Position 0 aus
Public Function Mci_Play()
  If Not OpenAlias Then Exit Function
  ErrMsg mciSendString("play " & StdAlias & " from 0", 0, 0, 0)
End Function

' stoppen der Wiedergabe
Public Function Mci_Stop()
  If Not OpenAlias Then Exit Function
  mciSendString "stop " & StdAlias, 0, 0, 0
End Function

' ermitteln der aktuellen Abspielposition
Public Function Mci_GetPos() As Long
  Dim Pos As String * 256
  If Not OpenAlias Then Exit Function
 
  mciSendString "status " & StdAlias & " position", Pos, Len(Pos), 0&
  On Error Resume Next
  Mci_GetPos = Left$(Pos, InStr(1, Pos, vbNullChar) - 1)
End Function

' schreiben Sie diesen Code bitte in ein Formular und fügen sie ein Bildfeld, einen  Timer, 
' 2 Commandbuttons und 3 Menüs in das Formular (Mnu_Open, Mnu_Close, Mnu_End) ein
Private Declare Function GetOpenFileNamePreview Lib "msvfw32.dll" ( _
  ByRef lpofn As  OPENFILENAME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Const OFN_ALLOWMULTISELECT = &H200  ' Mehrfachauswahl wird unterstützt
Const OFN_CREATEPROMPT = &H2000  ' Dialog zum Erstellen einer Datei wird  
' eingeblendet, wenn die gewählte Datei nicht existiert
Const OFN_ENABLEHOOK = &H20  ' aktiviert die Callback-Funktion Hook
Const OFN_ENABLESIZING = &H800000  ' (Win 2000) die Dialoggröße kann geändert werden
Const OFN_ENABLETEMPLATE = &H40  ' aktiviert Templates
Const OFN_ENABLETEMPLATEHANDLE = &H80  ' benutzt den vorgeladenen Dialog
Const OFN_EXPLORER = &H80000  ' der Dialog hat den Explorer Styl
Const OFN_EXTENSIONDIFFERENT = &H400  ' die Funktion setzt diese Konstante wenn eine  
' andere Dateiendung ausgewählt wurde als angegeben
Const OFN_FILEMUSTEXIST = &H1000  ' die Datei muss existieren
Const OFN_HIDEREADONLY = &H4  ' versteckt schreibgeschützte Dateien
Const OFN_LONGNAMES = &H200000  ' erlaubt lange Dateinamen
Const OFN_NOCHANGEDIR = &H8  ' wechselt nicht das Windowsverzeichnis
Const OFN_NODEREFERENCELINKS = &H100000  ' Wenn eine Verknüpfung gewählt wird gibt  
' die Funktion die verknüpfte Datei zurück
Const OFN_NOLONGNAMES = &H40000  ' erlaubt nur Dos-Dateinamen
Const OFN_NONETWORKBUTTON = &H20000  ' versteckt den Netzwerk-Button
Const OFN_NOREADONLYRETURN = &H8000  ' die Funktion setzt dieses Flag, wenn die Datei  
' nicht schreibgeschützt ist
Const OFN_NOTESTFILECREATE = &H10000  ' um ein Laufwerk auf seine Schreibfähigkeit  
' zu prüfen, wird eine Testdatei geschrieben, was hiermit verhindert wird
Const OFN_NOVALIDATE = &H100  ' überprüft den Dateinamen nicht auf gültige Zeichen
Const OFN_OVERWRITEPROMPT = &H2  ' blendet einen Dialog zum Überschreiben einer  
' Datei ein
Const OFN_PATHMUSTEXIST = &H800  ' der Pfad muss existieren
Const OFN_READONLY = &H1  ' aktiviert das Häkchen in der Checkbox   
' "mit Schreibschutz öffnen"
Const OFN_SHAREAWARE = &H4000  ' ignoriert, wenn Shared-Dateien ausgewählt werden
Const OFN_SHOWHELP = &H10 ' zeigt den Hilfe-Button an, bei einem Klick auf ihn 
' empfängt die Hook-Funktion die WM_HELP Message
 
Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

' starten der Wiedergabe
Private Sub Command1_Click()
  Mci_Play
End Sub

' stoppen der Wiedergabe
Private Sub Command2_Click()
  Mci_Stop
End Sub

' Treiber schließen und Datei entladen
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Mci_Close
End Sub

' schließen einer Multimedia-Datei (Menü - Schließen)
Private Sub Mnu_Close_Click()
  Mci_Close
End Sub

' beenden des Programms (Menü - Beenden)
Private Sub Mnu_End_Click()
  Unload Me
End Sub

' öffnen und laden einer Multimedia-Datei (Menü - Öffnen)
Private Sub Mnu_Open_Click()
  Dim OF As OPENFILENAME, RetVal As Long
 
  With OF
    .lStructSize = Len(OF)
    .hInstance = App.hInstance
    .hwndOwner = Me.hWnd
    .lpstrTitle = "Multimediadatei Öffnen"
    .lpstrFilter = GetMciFileTypes
    .nFilterIndex = 1
    .lpstrFile = Space(512) & Chr(0)
    .nMaxFile = Len(.lpstrFile)
    .flags = OFN_EXPLORER
  End With
 
    ' Preview-Dialog anzeigen
  RetVal = GetOpenFileNamePreview(OF)
  CloseHandle RetVal
 
    ' falls Datei gewählt, dann die Datei mit dem Treiber öffnen
  If RetVal <> 0 Then
    Picture1.Cls
    Mci_Open Left$(OF.lpstrFile, InStr(1, OF.lpstrFile, vbNullChar) - 1)
  End If
End Sub

' abfragen der aktuellen Abspielposition
Private Sub Timer1_Timer()
  Dim Seconds As Long, Minutes As Long, Hours As Long
 
  ' Millisekunden in ein Stunden:Minuten:Sekunden-Format umrechnen
  Seconds = Fix(Mci_GetPos / 1000)
  Hours = (Seconds - (Seconds Mod 60)) / 60 / 60
  Minutes = (Seconds - (Hours * 60) - (Seconds Mod 60)) / 60
  Seconds = Seconds - (Hours * 60 * 60) - (Minutes * 60)
 
  ' Zeitformat im Labelfeld ausgeben
  Label1.Caption = Format(Hours, "00:") & Format(Minutes, "00:") &  _
  Format(Seconds, "00")
End Sub