vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Schützen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Audio & Multimedia15.04.02
mciGetErrorString-Funktion

Diese Funktion ermittelt den Fehlertext eines Fehlercodes, der von der mciSendString-Funktion zurückgegeben wurde.

Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinMEViews:  10.219 

Deklaration:

Declare Function mciGetErrorString Lib "winmm.dll" _
  Alias "mciGetErrorStringA" ( _
  ByVal fdwError As Long, _
  ByVal lpszErrorText As String, _
  ByVal cchErrorText As Long) As Long


Beschreibung:

Diese Funktion ermittelt den Fehlertext eines Fehlercodes, der von der mciSendString-Funktion zurückgegeben wurde.


Parameter:

fdwErrorErwartet den Fehlercode zu dem der Fehlertext ermittelt werden soll.
lpszErrorTextErwartet einen Puffer, der mit Leezeicheninitialisiert ist um den Fehlertext zu empfangen.
cchErrorTextErwartet die Größe des Puffers in Bytes.


Rückgabewert:

Ist die Funktion erfolgreich so ist ein Wert "ungleich 0" die Rückgabe, andernfalls wird "0" zurückgegeben.

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
    .lpstrFile = Space(512)
    .nMaxFile = 512
    .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

Diese Seite wurde bereits 10.219 mal aufgerufen.

nach obenzurück
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel