hex in Dezimal Überlauf

31/07/2008 - 14:29 von Hubert Scheidgen | Report spam
Hallo Ng,

ich bin hier auf ein merkwürdiges Phànomen gestossen.
Siehe den auskommentierten Teil mit dem Überlauffehler.
Falls es jemand nicht auf Anhieb sehen sollte: es geht ums Auslesen bestimmter
ID3v2 Tags.
Die Function làuft sehr gut und bis jetzt fehlerfrei, weil ich den Dezimalwert
jedes einzelnen Bytes in der Long Variablen Beite() speichere. und erst dann
die Multiplikation ausführe. Aber seht selbst:

Gruß
Hubert

Option Explicit
Function ID_TAG_auslesen(Tagname As String, Ueberschrift As String)
' Autor: Hubert Scheidgen 07.2007

Dim b As Byte, Zeile As Byte, Spalte As Byte, i As Long ' alles nie größer als 255
Dim TagInhalt As String
Dim Pfad As String, Datei As String
' Dim TN As String ' nicht mehr notwendig und wurde ersetzt durch das allgemeinere "Taginhalt"
Dim Knz As String * 4 'Tagheader
Dim ID3Knz As String * 3 'die ersten 3 Bytes eines ID3v2 Containers
Dim Leseposition As Long
Dim ID3Laenge As String * 4 'ID3v2 Lànge im ASCII Format
Dim lngID3Laenge As Long 'ID3v2 Grösse in Bytes (=Anzahl Bytes in Dezimal-Form)
Dim Beite(1 To 4) As Long
Dim Ende As Long
'Dim Spaltennummer As Integer ' auch nicht mehr notwendig, weil jetzt in die aktive Spalte eingefügt wird

On Error GoTo Fehler

If ActiveSheet.Index <> 1 Then
MsgBox ("falsches Arbeitsblatt ausgewàhlt")
Exit Function
End If

Spalte = ActiveCell.Cells.Column

Pfad = Worksheets(3).Range("A1").Value & "\"
' Spalte = Spaltennummer
Zeile = 2
Tagname = UCase(Tagname)


Do Until IsEmpty(Worksheets(2).Range("A" & Zeile)) = True
Datei = Pfad & Worksheets(2).Range("A" & Zeile).Value

Open Datei For Binary Access Read As #1
Get #1, 1, ID3Knz

If ID3Knz <> "ID3" Then
'MsgBox ("Eine oder mehrere MP3 Dateien" & Chr(13) _ 'auskommentiert,
'& "enthalten keine ID3v2 Tags") ' weil: sehe ich ja anschliessend
sowieso
Close #1
Else
'ID3v2 Containerlànge feststellen
Get #1, 7, ID3Laenge

Beite(1) = Asc(Left$(ID3Laenge, 1))
Beite(2) = Asc(Mid$(ID3Laenge, 2, 1))
Beite(3) = Asc(Mid$(ID3Laenge, 3, 1))
Beite(4) = Asc(Mid$(ID3Laenge, 4, 1))

lngID3Laenge = (&H200000 * Beite(1)) + _
(&H4000 * Beite(2)) + (&H80 * Beite(3)) + Beite(4)
'
' Wegen Überlauffehler Nr. 6 geht das hier leider nicht.
' Asc gibt einen Integer Wert zurück, aber für diese
' Operation hier muss es Long sein, wenn der ID3v2 Container
' sehr gross ist. Das ist sehr merkwürdig, finde ich, da Integer doch
' eigentlich reichen müsste. Kann es sein, dass man lngID3Laenge (as Long)
' nicht mit ASC() (as Integer) multiplizieren kann?
' Komisch nur, dass es mit den beiden geringwertigsten Bytes funktionieret.
' Erst ab dem dritten Byte kommt es zum Überlauf.
' Kann man testen, indem man schrittweise den Teil für die hochwertigen
' Bytes (also von links nach rechts) einfach weglàsst.

' lngID3Laenge = (&H200000 * Asc(Left$(ID3Laenge, 1))) + _
' (&H4000 * Asc(Mid$(ID3Laenge, 2, 1))) + _
' (&H80 * Asc(Mid$(ID3Laenge, 3, 1))) + _
' Asc(Mid$(ID3Laenge, 4, 1))
'
Leseposition = 11 '

Do Until Leseposition > lngID3Laenge

'FrmLng = 0
Ende = 0
Get #1, Leseposition, Knz

If UCase(Knz) = Tagname Then
Ende = Framegroesse(Leseposition) - 1
Seek 1, Leseposition + 4 + 7
b = "0"
For i = 1 To Ende
Get #1, , b
TagInhalt = TagInhalt & Chr(b)
Next i

Close #1

' Tracknummern sollen immer 2-stellig sein:
If Len(TagInhalt) = 1 And UCase(Tagname) = "TRCK" Then
TagInhalt = "0" & TagInhalt
End If

Worksheets("Tabelle1").Cells(Zeile, Spalte).Value = Trim(TagInhalt)
'Worksheets("Tabelle1").Range("B" & Zeile).Value = lngID3Laenge 'war nur zum Testen
TagInhalt = Empty
Exit Do


Else 'auslesen der Framegrösse
Leseposition = Leseposition + 10 + Framegroesse(Leseposition)
End If

Loop

End If
Close #1
' TN = Empty
Zeile = Zeile + 1

Loop

Worksheets("Tabelle1").Cells(1, Spalte).Value = Ueberschrift
Worksheets(1).Range("A:D").Columns.AutoFit
MsgBox ("Auslesen des ID3v2 Tags beendet")

Fehler:
Close #1

End Function

Function Framegroesse(Leseposition)
Dim i As Integer
Dim b As Byte
Dim FrmLng As String * 4 'Framelànge im ASCII Format
Dim lngFrmLng As Long 'Framegrösse in Bytes (=Anzahl Bytes in Dezimal-Form)
Dim Beite(1 To 4) As Long

For i = 0 To 3
Get #1, Leseposition + 4 + i, b
Next i
Get #1, Leseposition + 4, FrmLng

Beite(1) = Asc(Left$(FrmLng, 1))
Beite(2) = Asc(Mid$(FrmLng, 2, 1))
Beite(3) = Asc(Mid$(FrmLng, 3, 1))
Beite(4) = Asc(Mid$(FrmLng, 4, 1))

lngFrmLng = &H10000 * Beite(1) + _
&H1000 * Beite(2) + &H100 * Beite(3) + Beite(4)

'Leseposition = Leseposition + 10 + lngFrmLng ' wegen Änderung nicht mehr notwendig
Framegroesse = lngFrmLng
End Function
 

Lesen sie die antworten

#1 Peter Schleif
31/07/2008 - 15:14 | Warnen spam
Hubert Scheidgen schrieb am 31.07.2008 14:29 Uhr:

ich bin hier auf ein merkwürdiges Phànomen gestossen.
Siehe den auskommentierten Teil mit dem Überlauffehler.

' lngID3Laenge = (&H200000 * Asc(Left$(ID3Laenge, 1))) + _
' (&H4000 * Asc(Mid$(ID3Laenge, 2, 1))) + _
' (&H80 * Asc(Mid$(ID3Laenge, 3, 1))) + _
' Asc(Mid$(ID3Laenge, 4, 1))



Das Problem sind die _impliziten_ Typ-Umwandlungen. Die vier
Teilausdrücke werden zunàchst einzeln berechnet. Dabei bekommt jeder
Ausdruck implizit einen Typ zugewiesen, der von der jeweils ersten
Komponente des Ausdrucks abhàngt und nur so groß gemacht wird, wie es
nötig ist:

&H4000 = 16384 passt in einen Integer. Also bekommt dieser
Teil-Ausdruck auch nur den Typ Integer. Die Multiplikation erzeugt
dann den Überlauf.

Bei den anderen passiert das nicht: Der erste Teil-Ausdruck wird
automatisch nach Long gecastet. Die letzten beiden werden zwar auch
nur nach Integer gecastet, erzeugen aber keinen Überlauf:

MsgBox VarType(&H200000) '/Ausgabe: 3 = Long/
MsgBox VarType(&H4000) '/Ausgabe: 2 = Integer/
MsgBox VarType(&H80) '/Ausgabe: 2 = Integer/
MsgBox VarType(Asc("X")) '/Ausgabe: 2 = Integer/


Lösung: Erzwinge den Typ Long durch ein explizites type-cast:

lngID3Laenge = CLng(&H200000) * Asc(Left$(ID3Laenge, 1)) _
+ CLng(&H4000) * Asc(Mid$( ID3Laenge, 2, 1)) _
+ CLng(&H80) * Asc(Mid$( ID3Laenge, 3, 1)) _
+ Asc(Mid$( ID3Laenge, 4, 1))

Peter

Ähnliche fragen