Dim cCode As Byte
Dim dCode As Byte
Dim char As Byte
Dim NextC As Byte
Dim dCount As Integer
Dim ccount As Integer
Dim ptr2 As Long
Dim cdOpen As String
Dim cdDecompress As String
Dim cdExtract As String
Dim cdSave As String
Private Sub Command1_Click()
cd.ShowOpen
cdOpen = cd.FileName
Open cdOpen For Binary As #1
cd.ShowSave
cdSave = cd.FileName
Open cdSave For Binary As #2
Get #1, 1, char
ccount = 1
ptr2 = 1
For x = 2 To FileLen(cdOpen)
Get #1, x, cCode
If cCode = char Then
ccount = ccount + 1
GoTo 1
End If
If ccount = 1 Then
Put #2, ptr2, char
ptr2 = ptr2 + 1
char = cCode
Else
ccount = ccount
Put #2, ptr2, "*"
ptr2 = ptr2 + 1
Put #2, ptr2, ccount
ptr2 = ptr2 + 1
Put #2, ptr2, char
ptr2 = ptr2 + 1
char = cCode
ccount = 1
End If
1
Next x
Get #1, x, cCode
If cCode = char Then
ccount = ccount + 1
End If
If ccount = 1 Then
Put #2, ptr2, char
ptr2 = ptr2 + 1
char = cCode
Else
ccount = ccount
Put #2, ptr2, "*"
ptr2 = ptr2 + 1
Put #2, ptr2, ccount
ptr2 = ptr2 + 1
Put #2, ptr2, char
ptr2 = ptr2 + 1
char = cCode
ccount = 1
End If
Close #1
Close #2
End Sub
Private Sub Command2_Click()
cd.ShowOpen
cdDecompress = cd.FileName
Open cdDecompress For Binary As #1
cd.ShowSave
cdExtract = cd.FileName
Open cdExtract For Binary As #2
ptr2 = 1
For x = 1 To FileLen(cdDecompress)
Get #1, x, dCode
If dCode = 42 Then
x = x + 1
dCount = x 'sets the number of times
x = x + 1 'sets Next Character
Get #1, x, dCode
For i = 1 To dCount
Put #2, ptr2, dCode
ptr2 = ptr2 + 1
Next i
Else
Put #2, ptr2, dCode
ptr2 = ptr2 + 1
End If
Next x
End Sub