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

Die Komprimierung liefert genau dann optimale Ergebnisse, wenn als Markierungs-Byte dasjenige genommen wird, welches am wenigsten häufig in dem zu komprimierendem Text vorkommt. Die unten stehenden Funktion RLEGetBestByte macht genau dies: Ihr muss dazu ein Byte-Array Data() mit den zu komprimierenden Daten übergeben werden.

Beispiel

Im folgenden Beispiel wird die Datei "Explorer.exe" in ein Byte-Array geladen und anschließend mit zwei verschiedenen Markierungs-Bytes komprimiert:

Sub Test()
  Dim FileNr As Long
  Dim Data() As Byte
  Dim RLE() As Byte
  Dim BestByte As Byte
  Dim n As Long
  
  'Datei laden:
  FileNr = FreeFile
  Open Environ$("windir") & "\Explorer.exe" For Binary As #FileNr
    n = LOF(FileNr)
    ReDim Data(1 To n)
    Get FileNr, , Data
  Close #FileNr
  
  'Komprimierung mit "0" als Markierungs-Byte:
  RLECompressPrinzip Data(), RLE(), 0
  On Error Resume Next
  MsgBox "Einsparung: " & Format$(n / UBound(RLE) - 1, "0%")
  If Err.Number = 9 Then MsgBox "Einsparung: keine"
  On Error GoTo 0
  
  'Komprimierung mit optimalem Markierungs-Byte:
  BestByte = RLEGetBestByte(Data)
  MsgBox "Markierungs-Byte: " & BestByte
  RLECompressPrinzip Data(), RLE(), BestByte
  MsgBox "Einsparung: " & Format$(n / UBound(RLE) - 1, "0%")
End Sub

In meiner Umgebung (WinNT4SP6) bringt die Komprimierung mit Markierungs-Byte "0" überhaupt keine Einsparung. Mit dem optimalen Markierungs-Byte (bei mir "6") wird eine Einsparung von 10% erreicht.

Code

Der Algorithmus ist eigentlich recht einfach: Zuerst wird gezählt, wie oft die 256 möglichen Bytes im Array vorkommen. Falls dabei ein Byte 255-mal vorkommt, wird das Zählen abgebrochen (wir begnügen uns dann mit einer Schätzung soweit). Anschließend wird das Minimum der 256 verschiedenen Byte-Vorkommen bestimmt. Natürlich ist "0" das Optimum, daher kann in so einem Fall vorzeitig abgebrochen werden.

Function RLEGetBestByte(ByRef Data() As Byte) As Byte
  Dim ByteCount(0 To 255) As Byte
  Dim Index As Long
  Dim Value As Byte
  
  'Vorkommen der Bytes zählen:
  For Index = LBound(Data) To UBound(Data)
    Value = Data(Index)
    ByteCount(Value) = ByteCount(Value) + 1
    'Abbrechen, falls Überlauf droht:
    If ByteCount(Value) = 255 Then Exit For
  Next Index
  
  'Minimum bestimmen:
  Value = 255
  For Index = 0 To 255
    If ByteCount(Index) < Value Then
      RLEGetBestByte = Index
      Value = ByteCount(Index)
      'Abbrechen, falls Optimum erreicht:
      If Value = 0 Then Exit For
    End If
  Next Index
End Function

---

...>>