Procedure pour ecrire les tags mp3

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Parole De JOJO
Messages : 446
Inscription : mar. 25/mai/2010 17:24
Localisation : Bnei Brak, Israel

Procedure pour ecrire les tags mp3

Message par Parole De JOJO »

merci a tout ceux qui m'ont aide, j'ai enfin reussi a faire une procedure qui reecrit les tags

Code : Tout sélectionner

; ****Write_Tags_MP3
; **** Parole De JOJO


Procedure BinVal(a$):a$=Trim(UCase(a$))
If Asc(a$)='%':a$=Trim(Mid(a$,2,Len(a$)-1)):EndIf
Result=0:*adr.Byte=@a$:For i=1 To Len(a$):Result<<1
Select *adr\b:Case '0':Case '1':Result+1:Default:i=Len(a$):EndSelect
*adr+1:Next:ProcedureReturn Result:EndProcedure
Procedure id3(tt.s,value.s):len=Len(value)
PokeS(Mem_ID3+mempos,tt):PokeB(Mem_ID3+mempos+7,len+1):PokeS(Mem_ID3+mempos+11,value):mempos+11+len:EndProcedure

Procedure Write_Tags_MP3(file.s,titre.s,album.s,artist.s,piste.s,genre.s,year.s,comments.s)
Dim idt.s(8):idt(1)=titre:idt(2)=album:idt(3)=artist:idt(4)=piste:idt(5)=genre:idt(6)=year:idt(7)=comments
; mesure totale
lenall=10; longueur de l'en tete ID3
For k=1 To 7:lenall+Len(idt(k)):Next; longueur des champs
lenall+11*7; longueur des additions, 4 de titre et 7 vides
lenall+4; longueur additif de comm
lenall+30; pour faire joli
Mem_ID3=AllocateMemory(lenall):PokeS(Mem_ID3,"ID3")
PokeB(Mem_ID3+3,3):PokeB(Mem_ID3+7,0):PokeB(Mem_ID3+8,50):PokeB(Mem_ID3+9,lenall-50):mempos=10
id3("TIT2",idt(1)):id3("TALB",idt(2)):id3("TPE1",idt(3))
id3("TRCK",idt(4)):id3("TCON",idt(5)):id3("TYER",idt(6))

len=Len(idt(7)):PokeS(Mem_ID3+mempos,"COMM"):PokeB(Mem_ID3+mempos+7,len+1+4):PokeS(Mem_ID3+mempos+11,"eng"):PokeS(Mem_ID3+mempos+15,idt(7))
mempos+11+len+5
Mem_TAG=AllocateMemory(128)
PokeS(Mem_TAG,"TAG",3):PokeS(Mem_TAG+3,idt(1),30):PokeS(Mem_TAG+33,idt(2),30)
PokeS(Mem_TAG+63,idt(3),30):;PokeS(Mem_TAG+93,idt(6),4)
:PokeS(Mem_TAG+97,idt(6),30)

If ReadFile(0,file)
*tampon.i=AllocateMemory(4):FileSeek(0,6):TagID3=ReadData(0,*tampon,10)
TagTailleBin.s=RSet(Bin(PeekB(*tampon)),7,"0"):TagTailleBin+RSet(Bin(PeekB(*tampon+1)),7,"0")
TagTailleBin+RSet(Bin(PeekB(*tampon+2)),7,"0"):TagTailleBin+RSet(Bin(PeekB(*tampon+3)),7,"0")
TagTaille=BinVal(TagTailleBin):
memo=AllocateMemory(2):FileSeek(0,Lof(0)-128):ReadData(0,memo,2):If PeekS(memo,2)="TA":tagtag=128:EndIf
tayfil=Lof(0)-tagtaille-tagtag

mem=AllocateMemory(tayfil)
FileSeek(0,tagtaille):ReadData(0,mem,tayfil):CloseFile(0)

If CreateFile(2,file)
WriteData(2,Mem_ID3,lenall):WriteData(2,mem,tayfil):WriteData(2,Mem_TAG,128):CloseFile(2)
Else:Debug "bug":EndIf:EndIf

EndProcedure
il me faut maintenant inserer dedans la procedure de Boddhi pour ne pas effacer l'image

Code : Tout sélectionner

; ****
; **** Lecture Frame APIC En-tête ID3v2
; **** Auteur : Boddhi           
; ****

EnableExplicit
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseJPEG2000ImageDecoder()

Enumeration ; Fenêtres
  #FENETRE
EndEnumeration
Enumeration ; Gadgets
  #TitCpMP3
  #CpMP3
  #TitDescription
  #CpDescription
  #TitType
  #CpType
  #ImgAPIC
EndEnumeration
Enumeration ; Images
  #Image1
EndEnumeration

Procedure.f Fc_MinF(ArgNombre1.f,ArgNombre2.f)
  If ArgNombre1>ArgNombre2:ProcedureReturn ArgNombre2:Else:ProcedureReturn ArgNombre1:EndIf
EndProcedure

Procedure.s Fc_TypeImage(ArgTypeImage.i)
  Define.s Chaine
  Select ArgTypeImage
    Case $00:Chaine="Autre"
    Case $01:Chaine="Icône PNG 32x32"
    Case $02:Chaine="Autre fichier icône"
    Case $03:Chaine="Jaquette avant"
    Case $04:Chaine="Jaquette arrière"
    Case $05:Chaine="Feuillet intérieur"
    Case $06:Chaine="Média"
    Case $07:Chaine="Soliste/Responsable graphique" ; Lead artist/Lead performer/soloist
    Case $08:Chaine="Artiste/Interprète"
    Case $09:Chaine="Chef d'orchestre"
    Case $0A:Chaine="Groupe/Orchestre"
    Case $0B:Chaine="Compositeur"
    Case $0C:Chaine="Parolier"
    Case $0D:Chaine="Lieu d'enregistrement"
    Case $0E:Chaine="Durée d'enregistrement"
    Case $0F:Chaine="Durée du concert"
    Case $10:Chaine="Capture vidéo"
    Case $11:Chaine="Poisson coloré lumineux" ; => ???? => Sont fous ces anglo-saxons !!!
    Case $12:Chaine="Illustration"
    Case $13:Chaine="Logo artiste/groupe"
    Case $14:Chaine="Logo studio/maison d'édition"
    Default:Chaine="Type inconnu"
  EndSelect
  ProcedureReturn Chaine
EndProcedure

Procedure.b Fc_LireFrameAPIC(ArgNofichier.i,ArgNomFichier.s)
  Define.i Position   ; Position 0 du tag APIC dans le fichier
  Define.i TagTaille,TagFlag,TailleChaine,Resultat,NoImage,TailleMemImage,TailleImageX,TailleImageY
  Define.b Unicode,TagTypeAPIC
  Define.i *Tampon
  Define.s TagNom,TagDescAPIC,TagDescImage
  Define.f Ratio

  Position=Loc(ArgNofichier)
  ; **** Lecture En-tête Tag ****
  *Tampon=AllocateMemory(10)
  ReadData(ArgNofichier,*Tampon,10)
  TagNom=PeekS(*Tampon,4,#PB_Ascii)
  If UCase(TagNom)<>"APIC"
    Resultat=#False
    Goto Fc_LireFrameAPIC_Fin
  EndIf
  TagTaille=PeekL(*Tampon+4)
  TagTaille=((TagTaille&$FF)<<24)+((TagTaille&$FF00)<<8)+((TagTaille&$FF0000)>>8)+((TagTaille>>24)&$FF)
  TagFlag=PeekB(*Tampon+8)<<8+PeekB(*Tampon+9)
  FreeMemory(*Tampon)
  ; Lecture Description Image
  Unicode=ReadByte(ArgNofichier)
  Position=Loc(ArgNofichier)
  *Tampon=AllocateMemory(64)
  ReadData(ArgNofichier,*Tampon,64)
  TagDescAPIC=PeekS(*Tampon,64*(Unicode+1),#PB_Ascii+Unicode)
  If TagDescAPIC="-->"
    TagTypeAPIC=0
    TagDescImage="Lien URL"
    ; ==> Code à compléter => J'ai jamais eu un type de genre sous la main pour tester
  Else
    Position+Len(TagDescAPIC)*(Unicode+1)+1
    FileSeek(ArgNofichier,Position)
    TagTypeAPIC=ReadByte(ArgNofichier)&$FF
    TagDescImage=Fc_TypeImage(TagTypeAPIC)
    ; Capture Image
    Position+2
    FileSeek(ArgNofichier,Position)
    FreeMemory(*Tampon)
    TailleMemImage=TagTaille;-Position
    *Tampon=AllocateMemory(TagTaille)
    ReadData(ArgNofichier,*Tampon,TagTaille)
    Resultat=CatchImage(NoImage,*Tampon,TagTaille,#PB_Image_DisplayFormat)
   
    If Resultat
      If OpenWindow(#FENETRE,220,0,410,479,"APIC",#PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
        If CreateGadgetList(WindowID(#FENETRE))
          TextGadget(#TitCpMP3, 16, 20, 68, 20, "Fichier MP3")
          StringGadget(#CpMP3, 96, 20, 300, 20, ArgNomFichier, #PB_String_ReadOnly)
          TextGadget(#TitDescription, 16, 52, 64, 20, "Description")
          StringGadget(#CpDescription, 96, 52, 300, 20, TagDescAPIC, #PB_String_ReadOnly)
          TextGadget(#TitType, 16, 84, 64, 20, "Type")
          StringGadget(#CpType, 96, 84, 300, 20, TagDescImage, #PB_String_ReadOnly)
          TailleImageX=ImageWidth(NoImage)
          TailleImageY=ImageHeight(NoImage)
          If TailleImageX>300 Or TailleImageY>300
            Ratio=Fc_MinF(300/TailleImageX,300/TailleImageY)
            TailleImageX=TailleImageX*Ratio:TailleImageY=TailleImageY*Ratio
            ResizeImage(NoImage,TailleImageX,TailleImageY)
          EndIf
          ImageGadget(#ImgAPIC, 56, 132, 300,300,ImageID(#Image1),#PB_Image_Border)
          Repeat
          Until WaitWindowEvent()=#PB_Event_CloseWindow
        EndIf
      EndIf
    EndIf
  EndIf
Fc_LireFrameAPIC_Fin:
  FreeMemory(*Tampon)
  ProcedureReturn Resultat
EndProcedure
merci
Dernière modification par Parole De JOJO le ven. 17/sept./2010 9:47, modifié 2 fois.
boddhi
Messages : 604
Inscription : lun. 26/avr./2010 16:14
Localisation : S 48° 52' 31'' / O 123° 23' 33''

Re: Procedure pour ecrire les tags mp3

Message par boddhi »

Je viens de me rendre compte d'une coquille dans le code que je t'ai fourni :oops:

Au niveau de la procédure Fc_LireFrameAPIC(), il faut remplacer le ".b" par ".l" ou mieux par ".i".
En effet, à l'origine, cette procédure devait retourner simplement un résultat #True ou #False selon si l'image avait été correctement chargée ou non. Mais en cours de code, j'ai opté plutôt pour l'ImageID et j'ai oublié de changer le type retourné par la procédure...

Pour finir, juste un petit conseil...
Bien qu'il n'y ait aucune règle intangible en la matière, tu devrais toutefois aérer un peu ton code... Indentation du code, nombre d'instructions par lignes limité, ...
Ca le rendrait plus lisible et faciliterait son analyse par tous :wink:
Warkering
Messages : 808
Inscription : ven. 08/janv./2010 1:14
Localisation : Québec, Canada

Re: Procedure pour ecrire les tags mp3

Message par Warkering »

Compare le tiens à celui de Boddhi et tu comprendras! :wink:
Parole De JOJO
Messages : 446
Inscription : mar. 25/mai/2010 17:24
Localisation : Bnei Brak, Israel

Re: Procedure pour ecrire les tags mp3

Message par Parole De JOJO »

je n'ais pas compris
:idea:
Avatar de l’utilisateur
case
Messages : 1546
Inscription : lun. 10/sept./2007 11:13

Re: Procedure pour ecrire les tags mp3

Message par case »

il veux dire que ton code fait fouillis car pas d'indentation , c'est un pavé de texte , difficile a relire :)

celui de boddhi est plus aéré ,) voila ce qu'il voulais dire ^^
ImageImage
boddhi
Messages : 604
Inscription : lun. 26/avr./2010 16:14
Localisation : S 48° 52' 31'' / O 123° 23' 33''

Re: Procedure pour ecrire les tags mp3

Message par boddhi »

As-tu testé ton code :?:

Quelques remarques :

Code : Tout sélectionner

Procedure id3(tt.s,value.s)
  len=Len(value)
  PokeS(Mem_ID3+mempos,tt)
  PokeB(Mem_ID3+mempos+7,len+1)
  PokeS(Mem_ID3+mempos+11,value)
  mempos+11+len
EndProcedure
Mem_ID3 et mempos sont utilisées alors qu'elles ne sont pas passées en arguments depuis la procédure appelante...
Les as-tu déclarées en Global ??? Si oui, ça ne se voit pas dans ton code !!!

Code : Tout sélectionner

lenall+11*7; longueur des additions, 4 de titre et 7 vides
lenall+4; longueur additif de comm
lenall+30; pour faire joli
Du "pour faire joli" est à bannir :!:
La structure ID3 est clairement définie par convention et il n'y a rien qui doit faire joli :(

Code : Tout sélectionner

  PokeS(Mem_ID3,"ID3")
  PokeB(Mem_ID3+3,3)
  PokeB(Mem_ID3+7,0)
  PokeB(Mem_ID3+8,50)
  PokeB(Mem_ID3+9,lenall-50) 
Je te rappelle que la taille du tag ID3 se calcule de manière binaire avec le bit de poids fort à 0.
Il est évident que ta méthode de calcul, ici, n'est pas la bonne !!!

Tu ne tiens absolument pas compte non plus de la possibilité que les tags de ton fichier mp3 d'origine soient en unicode.

Je me suis arrêté là dans l'analyse de ton code car je doute qu'il fonctionne si tu ne respectes pas les points ci-dessus (et que les tags que tu auras créés soient exploitables par d'autres logiciels confirmés...) :)
Répondre