(950)  S'inscrire

Français
Source/ Codesnippets

Lecture Fichiers Mp2 Mp3

 

KompilierenMarqueSéparation
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
MP3- und MP2-Dateien auslesen
###########################
MP3 und MP2 -Files auslesen
Andreas Miethe * April 2001
benötigt Profan 7.xx
###########################
Anwendungsmöglichkeiten:
MP3-Player
MP3-Datenbank
###########################
Cls
Declare List&
Declare V1L1$,V1L2$,V1L3$,V2L1$,V2L2$,V2L3$
StringArrays für Bitrate
V1L1$ = 32,64,96,128,160,192,224,256,288,320,353,384,416,448,-1
V1L2$ = 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
V1L3$ = 32,40,48,56,64,80,96,112,128,160,192,224,256,320,-1
V2L1$ = 32,64,96,128,160,192,224,256,288,320,352,384,416,448,-1
V2L2$ = 32,48,56,64,80,96,112,128,160,192,224,256,320,384,-1
V2L3$ = 8,16,24,32,64,80,56,64,128,160,112,128,256,320,-1
List& = CreateListbox(%Hwnd,,0,0,0,0)
@Addstring (List&,0001)
@Addstring (List&,0010)
@Addstring (List&,0011)
@Addstring (List&,0100)
@Addstring (List&,0101)
@Addstring (List&,0110)
@Addstring (List&,0111)
@Addstring (List&,1000)
@Addstring (List&,1001)
@Addstring (List&,1010)
@Addstring (List&,1011)
@Addstring (List&,1100)
@Addstring (List&,1101)
@Addstring (List&,1110)
@Addstring (List&,1111)
Declare Datei$,DExt$
Datei$ = Track01.mp3Pfad anpassen
Filemode 0
gibt es die Datei ???
SetErrorlevel 1
Assign #1,Datei$
Reset #1
Close #1

If %IOResult

    @Messagebox( add$(Datei$, gibt es nicht
    Ende),Fehler...,0)
    end

Endif

SetErrorlevel 0
DExt$ = Upper$(Substr$(Datei$,2,.))

If or(DExt$ = MP3, DExt$ = MP2)

    nur wenn MP3 oder MP2 - Datei
    cls
    Declare Byte0&,Byte1&,Byte2&,Byte3&
    Declare Header#
    Declare ReadBytes#
    Declare xxx%
    Dim Header#,30
    Dim$ 147 Array für Genre-Strings
    Declare Emp$,Emphase$
    Declare Org$,Original$
    Declare Cop$,Copyright$
    Declare MEx$,Modextension$
    Declare Cha$,Chanels$
    Declare Ext$,Extension$
    Declare Pad$,Padding$
    Declare Sam$,Samplerate$
    Declare Btr$,Bitrate$
    Declare Err$,CRC$
    Declare Lay$,Layer$
    Declare Mpg$,Mpegversion$
    Declare sek&,Min&,Seks&,Miseks&
    Declare Tag$,Titel$,Interpret$,Album$,Jahr$,Koment$,Genreid$,Track&
    Declare ID3Tag#,fs&,read&
    Declare xx%
    Declare Zeile$
    ID3V2-Tag auslesen ?
    ist nicht ganz so einfach, da die Daten mit flexibler Länge
    abgelegt sind,deswegen schenke ich mir das hier ?
    Erstmal die ersten 4 Bytes des Headers auslesen !
    HEADER faengt nicht unbedingt bei 0 an,
    wenn es einen ID3V2-TAG gibt, dann beginnt
    der Header erst danach.
    Also suchen nach SyncWord Pos = ????
    Das erste Byte von SyncWord ist immer $ff
    und kommt im ID3V2-TAG niemals vor, also danach suchen.
    Assign #1,Datei$
    OpenRW #1
    Byte0& = @GetByte(#1)

    If equ(Byte0&,$FF)  Beginn von SyncWord bei 0

        Byte1& = @GetByte(#1)
        Byte2& = @GetByte(#1)
        Byte3& = @GetByte(#1)

    else

        ---------------------------
        im Speicher suchen
        Dim ReadBytes#,@FileSize(datei$)
        @BlockRead(#1,ReadBytes#,0,@FileSize(datei$))
        xxx%= @MemPos(ReadBytes#,0,chr$(255))ist jetzt schnell genug
        Dispose ReadBytes#
        ---------------------------
        seek #1,xxx%+1
        Byte0& = @GetByte(#1)
        Byte1& = @GetByte(#1)
        Byte2& = @GetByte(#1)
        Byte3& = @GetByte(#1)

    endif

    CloseRW #1
    ---------------------------
    Verarbeitung Bit 3
    Let Emp$ = Add$(Str$(Testbit(Byte3&,1)),Str$(Testbit(Byte3&,0)))
    Case Emp$ = 00 : Emphase$ = None
    Case Emp$ = 01 : Emphase$ = 50/15 microseconds
    Case Emp$ = 10 : Emphase$ = Dunno
    Case Emp$ = 11 : Emphase$ = CITT j.17
    Let Org$ = Str$(Testbit(Byte3&,2))
    Case Org$ = 0 : Original$ = No
    Case Org$ = 1 : Original$ = Yes
    Let Cop$ = Str$(Testbit(Byte3&,3))
    Case Cop$ = 0 : Copyright$ = No
    Case Cop$ = 1 : Copyright$ = Yes
    Let MEx$ = Add$(Str$(Testbit(Byte3&,5)),Str$(Testbit(Byte3&,4)))
    Kann nur zusammen mit Layer verarbeitet werden
    Let Cha$ = Add$(Str$(Testbit(Byte3&,7)),Str$(Testbit(Byte3&,6)))
    Case Cha$ = 00 : Chanels$ = Stereo
    Case Cha$ = 01 : Chanels$ = Joint Stereo
    Case Cha$ = 10 : Chanels$ = Dual Chanel
    Case Cha$ = 11 : Chanels$ = Mono
    Verarbeitung Bit 2
    Let Ext$ = Str$(Testbit(Byte2&,0))
    Case Ext$ = 0 : Extension$ = None
    Case Ext$ = 1 : Extension$ = Privat
    Let Pad$ = Str$(Testbit(Byte2&,1))
    Case Pad$ = 0 : Padding$ = Unused Bits are filled
    Case Pad$ = 1 : Padding$ = All Bits in Frame are used
    Let Sam$ = Add$(Str$(Testbit(Byte2&,3)),Str$(Testbit(Byte2&,2)))
    Kann nur zusammen mit Layer verarbeitet werden
    Let Btr$ = Add$(Add$(Add$(Str$(Testbit(Byte2&,7)),Str$(Testbit(Byte2&,6))),Str$(Testbit(Byte2&,5))),Str$(Testbit(Byte2&,4)))
    Kann nur zusammen mit Layer verarbeitet werden
    Verarbeitung Bit 1
    Let Err$ = Str$(Testbit(Byte1&,0))
    Case Err$ = 0 : CRC$ = On
    Case Err$ = 1 : CRC$ = Off
    Let Lay$ = Add$(Str$(Testbit(Byte1&,2)),Str$(Testbit(Byte2&,1)))
    Case Lay$ = 00 : Layer$ = ?
    Case Lay$ = 01 : Layer$ = 3
    Case Lay$ = 10 : Layer$ = 2
    Case Lay$ = 11 : Layer$ = 1
    Let Mpg$ = Add$(Str$(Testbit(Byte1&,4)),Str$(Testbit(Byte1&,3)))
    Case Mpg$ = 00 : Mpegversion$ = 2.5
    Case Mpg$ = 01 : Mpegversion$ = ?
    Case Mpg$ = 10 : Mpegversion$ = 2
    Case Mpg$ = 11 : Mpegversion$ = 1
    Verarbeitung von Modeextension, Bitrate und Sampelrate
    Sampelrate

    If equ$(Mpegversion$ , 1)

        Case Sam$ = 00 : Samplerate$ = 44100
        Case Sam$ = 01 : Samplerate$ = 48000
        Case Sam$ = 10 : Samplerate$ = 32000
        Case Sam$ = 11 : Samplerate$ = Stream-Error

    ElseIf equ$(Mpegversion$ , 2)

        Case Sam$ = 00 : Samplerate$ = 22050
        Case Sam$ = 01 : Samplerate$ = 24000
        Case Sam$ = 10 : Samplerate$ = 16000
        Case Sam$ = 11 : Samplerate$ = Stream-Error

    Endif

    Modeextension

    If equ$(Mpegversion$ , 1)

        Case Mex$ = 00 : Modextension$ = Frequenzband 4
        Case Mex$ = 01 : Modextension$ = Frequenzband 8
        Case Mex$ = 10 : Modextension$ = Frequenzband 12
        Case Mex$ = 11 : Modextension$ = Frequenzband 16

    ElseIf equ$(Mpegversion$ , 2)

        Case Mex$ = 00 : Modextension$ = Frequenzband 0
        Case Mex$ = 01 : Modextension$ = Frequenzband 4
        Case Mex$ = 10 : Modextension$ = Frequenzband 8
        Case Mex$ = 11 : Modextension$ = Frequenzband 16

    Endif

    Bitrate

    If and(equ$(Layer$ , 1),equ$(Mpegversion$ , 1))

        Bitrate$ = substr$(V1L1$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    ElseIf and(equ$(Layer$ , 2),equ$(Mpegversion$ , 1))

        Bitrate$ = substr$(V1L2$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    ElseIf and(equ$(Layer$ , 3),equ$(Mpegversion$ , 1))

        Bitrate$ = substr$(V1L3$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    ElseIf and(equ$(Layer$ , 1),equ$(Mpegversion$ , 2))

        Bitrate$ = substr$(V2L1$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    ElseIf and(equ$(Layer$ , 2),equ$(Mpegversion$ , 2))

        Bitrate$ = substr$(V2L2$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    ElseIf and(equ$(Layer$ , 3),equ$(Mpegversion$ , 2))

        Bitrate$ = substr$(V2L3$,(sendmessage(List&,$018F,0,addr(Btr$))+1),,)

    Endif

    Print If(equ(xxx%,0),Kein ID3V2-TAG vorhanden,ID3V2-TAG vorhanden)
    Print HeaderStart : ,Int(xxx%+1)
    Print Mpegversion : ,Mpegversion$
    Print Layer : ,Layer$
    Print Sampelrate :,Samplerate$,KHz
    Print Kanäle : ,Chanels$
    Print Bitrate :,Bitrate$,KBits/s
    Print Original :,Original$
    Print Copyright :,Copyright$
    Print Errorprotection :,CRC$
    Print Emphase :,Emphase$
    Print Modextension :,Modextension$
    Print Extension :,Extension$
    Print Padding :,Padding$
    Print
    hier wird gerechnet

    If val(Bitrate$) > 0  sonst kann es zu Fehlern beim Rechnen kommen

        Decimals 2
        Sek& = Int(@FileSize(Datei$) * 8  / (Val(Bitrate$)*1000) )
        Print Spieldauer : ,sek&,Sekunden
        Print Spieldauer : ,format$(00, int(sek&/60));:;format$(00, Mod(sek&,60)),Minuten
        Print
        Declare Framesize&,Filesize&,padding&
        case pad$=1:padding& =0
        case pad$=0:padding& =1
        Let Framesize& = ((144 * (val(bitrate$)*1000)) / val(samplerate$)) + padding&
        Let Filesize& = @FileSize(Datei$)
        Print Framesize :,Framesize&
        Print Frames    :, Int((Filesize&-128-xxx%)/ Framesize&)
        Print Filesize  :,Filesize&/1024/1024,MB
        Print Filename  :,Longname$(Datei$)
        Print

    endif

    ID3V1-Tag auslesen
    fs& = @FileSize(datei$)
    read& = fs& - 128
    Dim ID3Tag#,30
    Assign #1,Datei$
    OpenRW #1
    seek #1,read&
    @BlockRead(#1,header#,0,3)
    Tag$ = left$(string$(header#,0),3)
    @BlockRead(#1,header#,0,30)
    Titel$ = string$(header#,0)
    @BlockRead(#1,header#,0,30)
    Interpret$ = string$(header#,0)
    @BlockRead(#1,header#,0,30)
    Album$ =string$(header#,0)
    @BlockRead(#1,header#,0,4)
    Jahr$ = Left$(string$(header#,0),4)
    @BlockRead(#1,header#,0,29)
    Koment$ = string$(header#,0)
    @BlockRead(#1,header#,0,1)
    Track& = Byte(header#,0)
    @BlockRead(#1,header#,0,1)
    GenreId$ = left$(string$(header#,0),1)
    CloseRW #1
    Assign #2,Gernreliste.inc
    Reset #2

    WhileNot @Eof(#2)

        Input #2,Zeile$
        List$ xx% = Zeile$
        inc xx%

    EndWhile

    Close #2

    If tag$ = TAG

        Print Id3V1 - TAG
        case Titel$ > :    Print Titel       : +Titel$
        case Interpret$ > :Print Interpret   : +Interpret$
        case Album$ > :    Print Album       : +Album$
        case Jahr$ > :     Print Jahr        : +Jahr$
        case Koment$ > :   Print Komentar    : +Koment$
        case Genreid$ <> ÿ:Print Genre       : +@List$(ord(Genreid$))
        Case Track& > 0:     Print Track       : +str$(Track&)

    else

        Print Keine weiteren Informationen

    endif

    Print
    Waitinput
    Dispose Header#
    Dispose ID3Tag#

else

    @Messagebox( add$(Datei$, ist keine gültige Audio-Datei
    Ende),<
s=s4 href='./../../funktionsreferenzen/XProfan/faute/'>faute...,0) end endif Fin
 
16.07.2007  ▲
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

3.857 Views

Untitledvor 0 min.
Member 862464104.05.2024
Abigail14.12.2017
ByteAttack12.12.2017
Peter Max Müller12.12.2017
plus...

Themeninformationen

cet Thema hat 1 participant:

unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie