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