CompressRle




Global Text1 As String

Public Function compress()
On Error Resume Next

For Position = 1 To Len(Text1)
Word1 = Mid(Text1, Position, 1)
Word2 = Mid(Text1, Position + 1, 1)
Word3 = Mid(Text1, Position + 2, 1)

If Not Word1 = Word2 Then
Found = 2
Else

If Word1 = Word3 Then
Found = 1
End If
End If

Select Case Found
Case 1
X = 1
begin:
X = X + 1
mark = Mid(Text1, Position + X + 1, 1)
If mark = Word1 Then Goto begin
Word = Chr(255) & Chr(X) & Word1
Position = Position + X
Case 2
Word = Word1
End Select
Text = Text & Word
Next Position
Text1 = Text
End Function

Public Function uncompress()
On Error Resume Next

For Position = 1 To Len(Text1)
Word1 = Asc(Mid(Text1, Position, 1))
Word2 = Asc(Mid(Text1, Position + 1, 1))
Word3 = Asc(Mid(Text1, Position + 2, 1))
Word4 = Asc(Mid(Text1, Position - 1, 1))

If Word1 = 255 Then

For Position6 = 1 To Word2
Word = Word & Chr(Word3)
Next Position6
Word1 = ""
Word2 = ""
End If

If Word = "" Then

If Not Word4 = 255 Then
Word = Chr(Word1)
End If
End If
Text = Text & Word
Word = ""
Next
Text1 = Text
End Function
Assumes:Text1 is a global string variable










( compressrle.html )- by Paolo Puglisi - Modifica del 17/12/2023