XProfan

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),Fehler...,0)
    end

endif

End