DURÉE D'UN FICHIER AUDIO ET VIDÉO GRÂCE À L'API MCISENDSTRING

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