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
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.