Dezimal zu Binärumrechnung -> Fehler

D

Dark Ranger

Erfahrenes Mitglied
Hi
Kann mir irgendwer sagen, warum es bei folgendem Code zu einem Fehler kommt, wenn eine Zahl >= 32 umgerechnet werden soll:
Code: 
Function Dec2Bin(ByVal lngZahl As Long) As String
    Select Case lngZahl
        Case 0
            Dec2Bin = "0"
        Case 1
            Dec2Bin = "1"
        Case Else
            Dec2Bin = Dec2Bin(lngZahl \ 2) & IIf(lngZahl Mod 2, "1", "0")
    End Select
End Function

Folgender Code das gleiche Problem:
Code: 
Private Function Dec2Bin(ByVal Dec As Long) As String
' Von Dezimal in Binaer
Dim Rest As Long
Do
      Rest = Dec Mod 2              ' Den Rest bei einer Division durch 2 errechnen
      Dec2Bin = Rest & Dec2Bin      ' Rest und bishereige Binaer Zahl zusammentun
      Dec = Dec \ 2                 ' Dezimal Zahl durch 2 Teilen
Loop Until Dec = 0                  ' Solange bis Dezimal-Zahl = 0 ist
End Function

Fehler ist: Überlauf
Fehlernummer: 6

Wo liegt das Problem? Irgendwo im Speicher oder so?
 
Hallo Dark Ranger,

du meinst wohl eher das du keine Zahl größer 32 Bit umrechnen
kannst. Denn eine Dec Zahl größer 32 funktioniert problemlos
mit dem Code.
Erst wenn ich eine Zahl größer 32 Bit (Dec 2147483647) umrechne
kommt ein Überlauf, weil der Typ LONG in VB6 nur bis max -2147483647 bis2147483647 (32Bit) kann. Und unsigned Long gibt es nicht in VB6.

Mehr geht nicht, jedenfalls fällt mir auf die Schnelle nichts ein.
Falls doch würde mich das auch interessieren.

Gruß
Jens
 
Nein so wie ich mir das angeschaut habe übergebe ich die Dezimalzahl 32 und es gibt einen Fehler mit diesem Überlauf.

Mhhh muss ich wohl nochmal schauen.

Folgendes Problem:
Ich will Daten anlegen, die ich über die Binärwerte beliebig miteinander kombinieren kann.

Also:
1. Wert: 1 -> test
2. Wert: 10 -> test1
3. Wert 100 -> test2

Nun weiß ich zum beispiel bei dem Code: 101, dass test und test2 ausgewählt sind.
Im moment Selektiere ich den höchsten Wert aus der Tabelle, rechne das ganze in Dezimal um, multipliziere es mit 2 und rechne es wieder in Binär, habe auch alles überprüft und es werden die richtigen Sachen berechnet usw. allerdings gibt es einen Fehler sobald der Wert >= 32 ist.

Hat irgendwer einen Lösungsvorschlag? Den Quellcode habe ich gerade nicht zur Hand, leider.
 
Hallo Dark Ranger,

also wie schon gesagt, die von dir geposteten Functions funktionieren
beide wunderbar mit der Dezimalzahl 32 und auch größer.

Da musst du woanders einen Fehler haben und ohne Code zu sehen
wird es schwer diesen zu finden.

Die Idee an sich ist nicht schlecht mit den Bitkombinationen.
Ich mache das auch des öfteren.
Beachte aber das du an Grenzen stoßen wirst, denn mehr als 32
mögliche Werte funktionieren nicht wegen 32 Bit Long.

Jens
 
32 Werte sind glaube ich schon ausreichend.

Werde meinen Code nochmal durchschauen, habe ewig nichts mehr mit VB6 oder VBA gemacht. Bisschen was ist hängen geblieben. Aber eigentlich programmiere ich nur noch in PHP oder JAVA, deswegen ist die Syntax Umstellung manchmal ein bisschen schwierig.

Und auf PHP wollte ich nicht zurückgreifen, da es ein Programm für nur eine Person ist. JAVA ist mir dafür auch zu oversized und ich müsste mich erstmal mit den Datenbank Connections rumschlagen. Access scheint genau das richtige zu sein, auch wenn ich es nicht mag ^^
 
Hier ist mein Code mit dem ich es schaffe 10 Datensätze anzulegen, danach ist Schluß und es kommt der Fehler wie oben:

Code: 
Option Compare Database
Private Const binärBasis As Byte = 2

Private Sub abort_Click()
    Me.Visible = False
End Sub

Private Sub saveArt_Click()
    On Error GoTo Fehler
    Dim db As DAO.Database
    Dim result As DAO.Recordset
    Dim strSQL As String
    Dim Zahl As Long
    Dim cache As Variant
    
    If Not Trim(art.Value) = "" Then
        Set db = CurrentDb
        
        strSQL = "SELECT MAX(Nummer) AS HighArt FROM Art"
        
        Set result = db.OpenRecordset(strSQL)
        
        cache = result!HighArt
        
        If IsNull(cache) Then
            Zahl = 0
        Else
            Zahl = cache
        End If
        
        Zahl = Dec2Bin(nextValue(Bin2Dec(Zahl)))
        strSQL = "INSERT INTO Art(Nummer, Art) VALUES ('" & Zahl & "','" & Trim(art.Value) & "')"
        db.Execute (strSQL)
    End If
    GoTo Ende
Fehler:
    MsgBox "Fehler: " & Err.Description & " Nummer: " & Err.Number
    GoTo Ende
Ende:
End Sub

Private Function nextValue(Zahl As Long) As Long
    If Zahl = 0 Then
        nextValue = 1
    ElseIf Zahl = 1 Then
        nextValue = 2
    Else
        nextValue = Zahl * 2
    End If
End Function

Private Function Bin2Dec(ByVal Bin As String) As Long
' Von Binaer nach Dezimal umrechnen
Dim i As Long, lngLen As Long
lngLen = Len(Bin)                   ' Länge der Binärzahl
For i = lngLen To 1 Step -1         ' Für jede Stelle die Schleife durchgehen
     Bin2Dec = Bin2Dec + IIf(Mid$(Bin, i, 1) = "1", 2 ^ (lngLen - i), 0)
                                    ' umrechnen in Dezimal (siehe Erklärung oben)
Next i
End Function
 
Private Function Dec2Bin(ByVal Dec As Long) As String
' Von Dezimal in Binaer
Dim Rest As Long
Do
      Rest = Dec Mod 2              ' Den Rest bei einer Division durch 2 errechnen
      Dec2Bin = Rest & Dec2Bin      ' Rest und bishereige Binaer Zahl zusammentun
      Dec = Dec \ 2                 ' Dezimal Zahl durch 2 Teilen
Loop Until Dec = 0                  ' Solange bis Dezimal-Zahl = 0 ist
End Function

Die Tabelle sieht wie folgt aus:
Code: 
ID -> AutoWert -> Primärschlüssel
Nummer -> Zahl -> Long Integer (habe auch schon Text usw. versucht, keine Besserung)
Art -> Text

Jemand eine Idee woran es liegen könnte?

Edit:
Bei den 10 Datensätzen klappt alles wunderbar mit dem einfügen der Binären Zahlen
 
Hallo Dark Ranger,

aus deinem Code wird nicht so richtig ersichtlich wozu du
eigentlich die Umrechnung von Dec zu Bin und umgekehrt
benötigst.

Was genau soll im Feld Nummer gespeichert werden ?
Einen Dezimalwert oder einen Binärwert der mehrere Dezimalwerte
beinhalten kann (1,2,4,8,16 usw.)

Die Zeile
Zahl = Dec2Bin(nextValue(Bin2Dec(Zahl)))

macht irgendwie überhaupt keinen Sinn und da kommt mit
Sicherheit auch der falsche Wert raus.

Wenn Zahl = Dec2Bin sein soll muss Zahl schon mal als String
deklariert werden denn ein Long kann nicht 0101 sein.
Da würde 101 rauskommen und das wäre ja schon falsch.
Dec2Bin gibt ja auch richtigerweise einen String zurück.

Ich habe den Sinn noch nicht ganz verstanden, aber wenn du
genau sagst was du willst kann ich sicher helfen.

Da sind wahrscheinlich noch mehr Bugs drin, sag mal genau was du willst.

Jens
 
In Nummer stehen Binärwerte.

0101 wird nie vorkommen, da nur 0,1,2,4,8,16 usw. in Binärschreibweise vorkommen können.

Ich hole mir am Anfang den höchsten Wert aus der Tabelle, rechne diesen in Dezimal um, nehme den nächsten Wert und rechne das ganze wieder nach Binär.

Wäre im Moment bestimmt auch durch eine Binärverschiebung oder soetwas möglich, sodass ich gar nicht umrechnen brauche, aber so war es für mich einfacher zu rechnen.

Die ganze Prozedur wird dafür benötigt einen neuen Datensatz anzulegen, dieser bekommt halt immer den höchsten Wert und wird dann in der Datenbank eingetragen.
 
Hallo Dark Ranger,

schaue dir mal den Code an.
Ist natürlich jetzt etwas angepasst, da ich das mit VB6 getestet habe.
So funktioniert es und es wird immer bei einem neuen Datensatz
0 für 0
1 für 1
10 für 2
100 für 4
1000 für 8

aber du kombinierst ja nichts und von daher
verstehe ich nicht wofür das ganze in Binär gut sein soll.


Code: 
Private Sub saveArt_Click()
    
    On Error GoTo Fehler
    Dim db As DAO.Database
    Dim result As DAO.Recordset
    Dim strSQL As String
    Dim Zahl As String
    
    Dim art As String
    art = "Test"
        
        Set db = DAO.OpenDatabase("C:\test.mdb")
        
        strSQL = "SELECT MAX(Nummer) AS HighArt FROM Art"
        
        Set result = db.OpenRecordset(strSQL)
        
               
        If IsNull(result!HighArt) Then
            Zahl = 0
        Else
            Zahl = nextValue(Bin2Dec(result!HighArt))
        End If
        
              
        strSQL = "INSERT INTO Art(Nummer, Art) VALUES ('" & Dec2Bin(Zahl) & "','" & Trim(art) & "')"
        db.Execute (strSQL)
   
   
   
    GoTo Ende
Fehler:
    MsgBox "Fehler: " & Err.Description & " Nummer: " & Err.Number
    GoTo Ende
Ende:

End Sub

Jens
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück