|
begin process at 2008 08 08 21:29:41
 Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
DURÉE D'UN FICHIER AUDIO ET VIDÉO GRÂCE À L'API MCISENDSTRING
 Information sur la source
 Description
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
- 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
-
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
 Historique
- 18 mars 2006 18:38:59 :
- faute de frappe
- 18 mars 2006 19:43:28 :
- ajout du lien vers mon autre source
Sources de la même categorie
 Commentaires
 Discussions en rapport avec ce code source
|
CalendriCode
| | | L | M | M | J | V | S | D |
| | | | | 1 | 2 | 3 |
| 4 | 5 | 6 | 7 | 8 | 9 | 10 |
| 11 | 12 | 13 | 14 | 15 | 16 | 17 |
| 18 | 19 | 20 | 21 | 22 | 23 | 24 |
| 25 | 26 | 27 | 28 | 29 | 30 | 31 |
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|