Kontakt
DSVGO
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 SubIn 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.
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
© Jost Schwider, 02.02.2001-02.02.2001 - http://vb-tec.de/rle4.htm