durée d'une musique mp3 et wma

[avigeilpro]

Bonsoir.
Je cherche à réccuperer des informations dans un fichier mp3 ou wma, surtout la durée de la chanson. Si quelqu'un a une idée ou une piste je suis preneur
Merci d'avance à toute contribution.

[ProgElecT]

bonsoir
je viens de verifier, j'ai ce qu'il te faut, le projet est dans le ZIP
Comme tu pourras le voir, il peu servir pour bien d'autres extentions, par contre je n'est pas de fichier *.WMA pour faire l'essais, pour MP3 s'est bon
Salut
ExtraireInfosFichier.zip (3.5Ko)
Modification adresse du ZIP

[avigeilpro]

Je viens de vérifier mais cela ne me donne pas le temps que dure la chanson et c'est bien la seule chose qui m'interresse

[ProgElecT]

?
Je viens de verifier a nouveau avec le projet sur mon disque local, je recharge le zip pour verifier !!

[avigeilpro]

En fait je veux le code le plus simple pour réccupérer juste la durée de la chanson et rien d'autre.
Merci ProgElecT pour ton savoir

[ProgElecT]

Sa fonctionne apres decompression du zip, en tout cas pour *.mp3, *.AVI ....
Il ne faut recuperer que la partie

Public Sub informationsFichier()
'recuperé sur ce forum pour avoir les infos que tu recherche
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Dim objFolder As Folder
Dim strFileName As FolderItem
Dim TempsChanson As Date
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(Chemin) 'adapter le chemin
Set strFileName = objFolder.Items.Item(Fichier) 'adapter le fichier
 
If objFolder.GetDetailsOf(strFileName, 21) <> "" Then
  'NamIndx(21) = "Duration"
 TempsChanson = cdate(Trim$(objFolder.GetDetailsOf(strFileName, 21)))
End If
 
Set objShell = Nothing: Set objFolder = Nothing: Set strFileName = Nothing
End Sub
 

Merci ProgElecT pour ton savoir

J'ai et j'apprend encor beaucoup sur ce forum

[avigeilpro]

Je l'ai un peu modifier et l'ai transformé en fonction, ca donne cela :

 
Public Function TpsChanson(Chemin As String, Fichier As String) As Date
'recuperé sur ce forum pour avoir les infos que tu recherche
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Dim objFolder As Folder
Dim strFileName As FolderItem
Dim TempsChanson As Date
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(Chemin) 'adapter le chemin
Set strFileName = objFolder.Items.Item(Fichier) 'adapter le fichier
 
If objFolder.GetDetailsOf(strFileName, 21) <> "" Then
  'NamIndx(21) = "Duration"
 TempsChanson = CDate(Trim$(objFolder.GetDetailsOf(strFileName, 21)))
End If
 
Set objShell = Nothing: Set objFolder = Nothing: Set strFileName = Nothing
 
TpsChanson = TempsChanson
 
End Function
 

J'ai mis un fichier nommé tst.mp3 directement sur mon disque C, son adresse est donc : C:\tst.mp3.
J'appel la fonction de la manière suivante :

 
Dim Duree As Date
Duree = TpsChanson ("c:\", "tst.mp3")
 

Seulement j'obtiens 00:00:00. j'ai fait un pas à pas, il ne rentre pas dans le if

Aurais-je fais une erreur ?

PS: j'ai oublié de préciser que j'étais sous Windows 2000. Cela à peut-être une importance.

Quand au programme que tu m'as passé au départ, celui-ci n'affichait que 8 lignes numérotées de 1 à 8.

[ProgElecT]

Bonjour

Pour le nombre de ligne affichée, sela depant des infos disponibles dans l'entête du fichier et de son extention.
Je viens de verifier au Pro, etant sous windows 2000 Pack 4 , cela ne fonctionne pas, je ne savais pas qu'il y avais des restrictions
Desolé, car ce moyen est idéal car il n'y a pas besoin d'ouvrir un fichier volumineux en entier pour en retirer des infos.

Est il possible de recuperer sur une version Windows XP la dll shell32, et la mettre sous Windows 2000 ?
Je vais essayer demain, recupe sur mon PC perso, remplacement sur celui du Pro, on verra bien.

[avigeilpro]

Merci j'attend ta réponse avec impatience.

Sinon n'y a-t-il pas une autre façon de faire ? ne peut-on pas trouver cela en éditant le fichier en hexa par exemple ? j'ai essayé mais ne connaissant pas la structure d'un fichier mp3, c'est comme chercher une aiguille dans une botte de foin si quelqu'un connait je suis preneur

[ProgElecT]

Desolé

On ne peut pas modifier Shell32.dll, soit par copier/coller, impossible de renommer le fichier existant dans le dossier System32, ni de faire référence a la DLL la plus performante, windows reprend la DLL installée dans le dossier System32
J'ai fait des essais par lecture de fichier en différant mode, pour la même extension, des fois on trouve, d'autres fois non, d'autres fois l'infos n'est pas au même endroit, sans compter le temps de chargement du fichier car l'infos n'est pas toujours dans l'entête.
Si quelqu’un a une astuce ?
Je passe la main

Ce qui est visible sous XP avec le prog en Fichiers attachés (le N° et l'octet fournissant l'info)

0 Name : 00 - Mon coeur mon amour (Version radios).mp3
1 Size : 2*973 Ko
2 Type : Fichier audio MP3
3 Date Modified : 03/03/2006 21:48
4 Date Created : 05/01/2007 18:44
5 Date Accessed : 05/01/2007 18:52
6 Attributes : A
7 Status : Connecté
8 Owner : MEORDI\francis
19 Track Number : 1
21 Duration : 00:03:10
22 Bit Rate : 128kbps
23 Protected : Non
32 File Version :
33 Product Name : 44 kHz
34 Product Version : 2 (stéréo)

un autre fichier

0 Name : benjamin.jpg
1 Size : 90 Ko
2 Type : Image Paint Shop Pro 6
3 Date Modified : 30/12/2003 13:44
4 Date Created : 23/08/2004 17:57
5 Date Accessed : 05/01/2007 18:28
6 Attributes : A
7 Status : Connecté
8 Owner : MEORDI\francis
13 Pages : 1
26 Dimensions : 1026 x 750
27 Not used (Largeur) : 1026 pixels
28 Not used (Hauteur) : 750 pixels

un autre fichier

0 Name : DSCN0785.JPG
1 Size : 392 Ko
2 Type : Image Paint Shop Pro 6
3 Date Modified : 28/10/2006 21:41
4 Date Created : 03/11/2006 10:29
5 Date Accessed : 24/12/2006 18:33
6 Attributes : A
7 Status : Connecté
8 Owner : MEORDI\francis
13 Pages : 1
24 Camera Model : E4100
25 Date du cliché : 28/10/2006 21:41
26 Dimensions : 1600 x 1200
27 Not used (Largeur) : 1600 pixels
28 Not used (Hauteur) : 1200 pixels
31 Description : 2006:10:28 21:41:09

Salut

[ThierryAIM]

le plus étonnant c'est que ça :
http://www.microsoft.com/technet/scr....mspx?mfr=true
ne fonctionne pas non plus avec un W2k SP4

Peut-être poser la question sur le forum Windows 2000

[avigeilpro]

Ouai mais si je pose la question sur le forum windows 2000 ils vont me jeter et me dire que je ne suis pas sur le bon forum !!!
Y'a pa moyen d'utiliser un objet OLE ou un control ocx comme un lecteur, d'y mettre le fichier et que lui me donne la durée de la musique ?

[avigeilpro]

J'ai enfin une solution !!!!!
J'ai fait une recherche et suis tombé sur cela :

il y a un module nommé mp3.bas, et dans ce module la fonction Return_tps_min

voici le contenu du module :

 
'''Created By Michael Karathanasis 990728'''''''''''''''''''''
 
'pour executer le fichier texte
Public Declare Function ShellExecuteA Lib "shell32" (ByVal hwnd As Long, ByVal LPFile As String, ByVal PathFile As String, ByVal Other As String, ByVal Other2 As String, ByVal Param As Long) As Long
 
Public Bitrate As Integer
Public durée As Integer
Dim MpegVersion As Integer
Dim MpegLayer As Integer
 
''this function converts Binary string to decimal integer
Public Function BinToDec(BinValue As String) As Integer
BinToDec = 0
For i = 1 To Len(BinValue)
If Mid(BinValue, i, 1) = 1 Then
BinToDec = BinToDec + 2 ^ (Len(BinValue) - i)
End If
Next i
End Function
Public Function BinaryHeader(filename As String) As String
 
On Error Resume Next
 
Dim ByteArray(4) As Byte
FIO% = FreeFile
Open filename For Binary Access Read As FIO%
n& = LOF(FIO%): If n& < 256 Then Close FIO%: Return 'ny
 
Dim X As Byte
'''''start check startposition for header''''''''''''
'''''if start position <>1 then id3v2 tag exists'''''
   For i = 1 To 5000            'check up to 5000 bytes for the header
    Get #FIO%, i, X
    If X = 255 Then             'header always start with 255 followed by 250 or 251
        Get #FIO%, i + 1, X
        If X > 249 And X < 252 Then
            HeadStart = i       'set header start position
            Exit For
        End If
    End If
Next i
'''end check start position for header'''''''''''''
 
'''start extract the first 4 bytes (32 bits) to an array
   For z = 1 To 4 '
      Get #1, HeadStart + z - 1, ByteArray(z)
    Next z
 
Close FIO%
'start convert 4*1 byte array to 4*8 bits'''''
 BinaryHeader = ""
   For z = 1 To 4
    For i = 7 To 0 Step -1
      If Int(ByteArray(z) / (2 ^ i)) = 1 Then
        BinaryHeader = BinaryHeader & "1"
        ByteArray(z) = ByteArray(z) - (2 ^ i)
      Else
            If BinaryHeader <> "" Then
                BinaryHeader = BinaryHeader & "0"
            End If
      End If
  Next
Next z
'stop convert 4*1 byte array to 4*8 bits
End Function
Public Function ReadMP3(filename As String)
 
bin = BinaryHeader(filename)                     'extract all 32 bits
 
Version = Array(25, 0, 2, 1)                        'Mpegversion table
MpegVersion = Version(BinToDec(Mid(bin, 12, 2)))    'get mpegversion from table
Layer = Array(0, 3, 2, 1)                           'layer table
MpegLayer = Layer(BinToDec(Mid(bin, 14, 2)))        'get layer from table
 
Dim LayerVersion As String
LayerVersion = MpegVersion & MpegLayer 'combine version and layer to string
 
Select Case Val(LayerVersion)                        'look for the right bitrate table
    Case 11                                              'Version 1, Layer 1
    Brate = Array(0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448)
    Case 12                                              'V1 L1
    Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384)
    Case 13                                               'V1 L3
    Brate = Array(0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320)
    Case 21 Or 251                                         'V2 L1 and 'V2.5 L1
    Brate = Array(0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256)
    Case 22 Or 252 Or 23 Or 253                            ''V2 L2 and 'V2.5 L2 etc...
    Brate = Array(0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160)
Case Else                                               'if variable bitrate
    Bitrate = 1                                             'e.g. for Variable bitrate
    Exit Function
End Select
 
Bitrate = Brate(BinToDec(Mid(bin, 17, 4)))
 
End Function
Public Function Return_tps_min(chemin As String)
 Call ReadMP3(chemin)
    
 
     If Bitrate = 1 Then Bitrate = 128
     taille = FileLen(chemin)
     Dim durée As Integer
     durée = CInt(((taille) / (Bitrate)) * 0.008)
     Dim min As Integer
     Dim sec As Integer
            
    min = Int(durée / 60)
    sec = CInt(((CInt((durée / 60) * 100)) - (min * 100)) * 0.6)
    Return_tps_min = min & " : " & Format(sec, "00") & " Min"
End Function
 

Je n'ai pas encore regardé comment il fonctionnait mais ce qui est sûr c'est que ca fonctionne à merveille.

Merci d'avoir essayé de m'aider

[sovo]

Oui pourquoi pas ?? tu peux passer par le controle Windows Media Player, je ne suis pas sur mais je crois que ca devrais marche. Je n'ai pas VB avec moi je vais me pencher sur la question tout a l'heure.

[avigeilpro]

bon je me suis réjouit un peu vite.
J'ai essayé et sur 15 fichier il y en a 4 qui sont faux mais c'est déjà pas mal

Je continu de chercher.