Durée d'un fichier audio et vidéo grâce à l'api mcisendstring

Commenter

Contenu du snippet

Voilà un morceau de code pour récupérer la durée de fichiers vidéos (avi, mpg, wmv, asf...) et audios (mp3, wav...).
Avec à l'API mciSendString, on ouvre le fichier, on récupère sa durée et on le ferme.

Il existe aussi l'API AVIFileInfo mais elle met trop de temps à renvoyer cette valeur d'après mes tests.
Essayez de tester avec vos fichiers et dites-moi ce que ça donne. Dites-moi aussi si avez d'autres mèthodes pour effectuer cette opération rapidement et avec peu de code.

Source / Exemple : 


Option Explicit

'API Windows Multmedia à laquelle on envoit des commandes
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 Sub Form_Load()
   
   Dim sFichierTest As String
   Dim sDureeTrouvee As String
   
   'Pour tester, indiquez un nom de fichier multimédia (vidéo et son)
   sFichierTest = "D:\Documents\Mes Vidéos\MOV029.MOD"
   'on récupère la durée du fichier
   sDureeTrouvee = DureeFichier(sFichierTest)
   'on affiche le tout
   MsgBox "Fichier :" & vbTab & sFichierTest & vbCrLf & _
          "Durée :" & vbTab & sDureeTrouvee
   
End Sub

Private Function DureeFichier(sFichier As String) As String
   
   'On crée un buffer de 128
   Dim sRetString As String * 128
   
   On Error Resume Next
   
   'on ferme fichier au cas où il serait ouvert
   mciSendString "close fichier", 0, 0, 0
   'on ouvre le fichier passé en paramètre
   mciSendString "open """ & sFichier & """ type MPEGVideo alias fichier", 0, 0, 0
   'on règle le format temporel sur milliseconde
   mciSendString "set fichier time format ms", 0, 0, 0
   'on récupère la durée du fichier dans le buffer
   mciSendString "status fichier length", sRetString, 128, 0
   'on passe cette durée à la fonction FormatTemps et on l'affecte à la valeur de notre fonction
   DureeFichier = FormatTemps(CDbl(Replace(sRetString, Chr(0), "") / 1000))
   'et enfin on ferme fichier
   mciSendString "close fichier", 0, 0, 0

End Function

'Fonction qui renvoie la durée formatée ainsi 00:00:00
Private Function FormatTemps(dTemps As Double) As String

   Dim lHeure As Long
   Dim lMinute As Long
   Dim lSeconde As Long
   Dim lTemps As Long
   
   lTemps = Round(dTemps)
   lHeure = Int(lTemps / 3600)
   lMinute = Int((lTemps - 3600 * lHeure) / 60)
   lSeconde = lTemps - 3600 * lHeure - 60 * lMinute
   FormatTemps = Format(lHeure, "00") & ":" & Format(lMinute, "00") & ":" & Format(lSeconde, "00")

End Function

Conclusion :


Pour tester, ouvrez un nouveau projet et collez le code dans Form1.

Si vous voulez une source complète utilisant mciSendString, j'ai fait un lecteur complet ici:

http://www.vbfrance.com/codes/CLM-DIVX-PLAYER-LECTEUR-VIDEOS-DIVX-MPG-MPEG_18199.aspx

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (clementio)