VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Wie die Komprimierung in VB grundsätzlich realisiert werden kann, ist dem folgenden Code zu entnehmen. Der Prozedur wird ein Byte-Array Mem() mit den zu komprimierenden Daten übergeben. Weiterhin wird ein Byte-Array für das Ergebnis RLE() benötigt, sowie das Markierungs-Byte TagValue zur Kennzeichnung der Wiederholungen.

Beispiel

Im folgenden Beispiel wird ein String in ein Byte-Array überführt und dieses dann (mit dem Markierungs-Byte "0") komprimiert:

Sub TestCompressPrinzip()
  Dim s As String
  Dim RLE() As Byte
  Dim Data() As Byte
  Dim i As Long
  
  'String vorgeben:
  s = String$(5, "A") & String$(15, "B")
  Debug.Print s & " (" & Len(s) & " Zeichen)"
  
  'String in Byte-Array konvertieren:
  Data = StrConv(s, vbFromUnicode)

  'String als Bytes ausgeben:
  For i = 0 To UBound(Data)
    Debug.Print CStr(Data(i)); " ";
  Next i
  Debug.Print "(" & i & " Bytes)"

  'Komprimierung:
  RLECompressPrinzip Data, RLE, 0

  'Ergebnis ausgeben:
  For i = 0 To UBound(RLE)
    Debug.Print CStr(RLE(i)); " ";
  Next i
  Debug.Print "(" & i & " Bytes)"
End Sub

Die folgenden Ergebnisse werden im Direktfenster ausgegeben:

AAAAABBBBBBBBBBBBBBB (20 Zeichen)
65 65 65 65 65 66 66... (insgesamt 15 mal) 66 (20 Bytes)
0 4 65 0 14 66 (6 Bytes)

Das heisst also, dass der ursprüngliche String auf 6 Bytes komprimiert wurde. Man beachte, dass die gespeicherte Wiederholungs-Anzahl (hier fett dargestellt) immer um eins kleiner ausfällt, als eigentlich gedacht. Dies geschieht aus Einsparungsgründen: So steht "0" für eine Wiederholung, und "255" für 256 Wiederholungen.

Code

Die Komprimierung besteht im Prinzip aus folgenden Schritten: Für jedes Byte wird geprüft, ob es mehrfach hintereinander auftritt. Wenn es mehr als 3-mal auftaucht, wird die Markierung mitsamt Komprimier-Parameter geschrieben, ansonsten wird einfach kopiert.

Ein kleines Problem haben wir, wenn die gesamte Komprimierung nichts einspart: Der Einfachheit halber wird dann ein leeres Array zurückgegeben.

Sub RLECompressPrinzip( _
    ByRef Mem() As Byte, _
    ByRef RLE() As Byte, _
    ByVal TagValue As Byte _
  )
  Dim MemPos As Long
  Dim MemLen As Long
  Dim MemValue As Byte
  Dim RLEPos As Long
  Dim Anzahl As Long
  Dim i As Long
  
  'Initialisierung:
  MemPos = LBound(Mem)
  MemLen = UBound(Mem)
  RLEPos = MemPos
  ReDim RLE(RLEPos To MemLen + 3)
  
  'RLE-Codierung:
  Do While RLEPos < MemLen
    'Anzahl gleicher Bytes bestimmen:
    MemValue = Mem(MemPos)
    i = MemPos + 255: If i > MemLen Then i = MemLen
    For i = MemPos + 1 To i
      If Mem(i) <> MemValue Then Exit For
    Next i
    Anzahl = i - MemPos
    MemPos = i
    
    'RLE-Code für das Byte erzeugen:
    If Anzahl > 3 Or MemValue = TagValue Then
      'Komprimieren:
      RLE(RLEPos) = TagValue
      RLE(RLEPos + 1) = Anzahl - 1
      RLE(RLEPos + 2) = MemValue
      RLEPos = RLEPos + 3
    Else
      'Kopieren:
      For RLEPos = RLEPos To RLEPos + Anzahl - 1
        RLE(RLEPos) = MemValue
      Next RLEPos
    End If
    If MemPos > MemLen Then Exit Do
  Loop
  
  'Ergebnis formatieren:
  If RLEPos <= MemLen Then
    ReDim Preserve RLE(LBound(Mem) To RLEPos - 1)
  Else
    Erase RLE()
  End If
End Sub

---

...>>