PakString

If Len(Dict$) <> 320 Then 'just To check...
     MsgBox "PACKING ERROR: Dictionary is the wrong size"
     Exit Function
  End If

If Not Left$(text$, 1) = Chr$(255) Then 'check if the String is packed
    'the string isn't packed so pack it...
     If Len(text$) < 4 Then Exit Function 'no use With strings less than 4
     chars.

For a = 1 To Len(text$) 'check If there are any characters
         v = Asc(Mid$(text$, a, 1)) ' With values out of range (they
         If v < 32 Or v > 127 Then Exit Function ' _cannot_ be packed otherwise)
     Next a
     Do
       DoEvents
       cnt = cnt + 1'read pointer in text$
       Chars$ = Mid$(text$, cnt, 2) 'characters To be checked For In Dict$

If cnt = Len(text$) Then'if the End of the String has been reached
          text$ = Chr$(255) + temp$ + Chr$(Asc(Mid$(text$, cnt, 1)) - 32)
          Exit Function '^^^^ add the last character
       End If

xx = 1 'read pointer in Dict$
     ReDo:
     x = InStr(xx, Dict$, Chars$) '4;1;120;1;0xp

If x Then'if the characters from text$ are In Dict$
        If (x \ 2) = (x / 2) Then 'if the instr of the characters can't be
           xx = x + 1 ' divided by 2 Then look again (it needs
           Goto ReDo' to be divided so it can be packed)
        End If
        temp$ = temp$ + Chr$((x \ 2) + 96) 'add the instr of the characters
        cnt = cnt + 1 ' In Dict$ To temp$ (note that
        '^^^ characters shouldn't ' it's stored 
        'so that it's more be compressed twice ' than 95)
              PackTxt = temp$
     Else
        'if the characters aren't found store the first
        'character (note that it's less than 95 and that
        'cnt is only moved up _1_)
        temp$ = temp$ + Chr$(Asc(Mid$(text$, cnt, 1)) - 32)
     End If
  
     Loop While cnt < Len(text$)
          text$ = Chr$(255) + temp$ 'copy temp$ into text$ and add CHR$(255)
          PackTxt = text$
          Exit Function ' To indicate a packed String
  Else
    'text$ is packed so unpack it
     comp$ = Right$(text$, Len(text$) - 1) 'remove CHR$(255)
     text$ = ""'re-init text$
     For x = 1 To Len(comp$)
         Chars$ = Asc(Mid$(comp$, x, 1))
         If Chars$ > 95 Then 'if char > 95 then char is the instr of the
            ' unpacked characters in Dict$, remember?
            text$ = text$ + Mid$(Dict$, (Chars$ - 96) * 2 + 1, 2)
            PackTxt = text$
         Else 'if the characters weren't found In Dict$ they were stored
              'value less than 95 (most are found, though)
            text$ = text$ + Chr$(Asc(Mid$(comp$, x, 1)) + 32)
            PackTxt = text$
         End If
      Next x
  End If
  PackTxt = text$
  End Function

Public Function PackTxt(text$) As String
d1$ = " e as tinthouerhet anreesr d onn or o i y wo tontyo. neisarte"
d2$ = "ed, ctiy bat snd fal pensestvengitu talehaurllcousa mf dfoof "
d3$ = "siril hmeg om Icehironsasiossbedepe rli Tetel nicho lilprcactut"
d4$ = "Thpaeceachh wige ebuaisursulmawaotowtsmploI solyee Cunm rtieno S"
d5$ = "diwhs.rafincademe.irplk ury Pwoacos gams,duayavucColamowe Aoopu"
Dict$ = d1$ + d2$ + d3$ + d4$ + d5$

If Len(Dict$) <> 320 Then 'just To check...
MsgBox "PACKING ERROR: Dictionary is the wrong size"
Exit Function
End If

If Not Left$(text$, 1) = Chr$(255) Then 'check if the String is packed
'the string isn't packed so pack it...

If Len(text$) < 4 Then Exit Function 'no use With strings less than 4
chars.

For a = 1 To Len(text$) 'check If there are any characters
v = Asc(Mid$(text$, a, 1)) ' With values out of range (they
If v < 32 Or v > 127 Then Exit Function ' _cannot_ be packed otherwise)
Next a
Do
DoEvents
cnt = cnt + 1'read pointer in text$
Chars$ = Mid$(text$, cnt, 2) 'characters To be checked For In Dict$

If cnt = Len(text$) Then'if the End of the String has been reached
text$ = Chr$(255) + temp$ + Chr$(Asc(Mid$(text$, cnt, 1)) - 32)
Exit Function '^^^^ add the last character
End If

xx = 1 'read pointer in Dict$
ReDo:
x = InStr(xx, Dict$, Chars$) '4;1;120;1;0xp

If x Then'if the characters from text$ are In Dict$
If (x \ 2) = (x / 2) Then 'if the instr of the characters can't be
xx = x + 1 ' divided by 2 Then look again (it needs
Goto ReDo' to be divided so it can be packed)
End If
temp$ = temp$ + Chr$((x \ 2) + 96) 'add the instr of the characters
cnt = cnt + 1 ' In Dict$ To temp$ (note that
'^^^ characters shouldn't ' it's stored

'so that it's more be compressed twice ' than 95)

PackTxt = temp$
Else
'if the characters aren't found store the first

'character (note that it's less than 95 and that

'cnt is only moved up _1_)

temp$ = temp$ + Chr$(Asc(Mid$(text$, cnt, 1)) - 32)
End If

Loop While cnt < Len(text$)
text$ = Chr$(255) + temp$ 'copy temp$ into text$ and add CHR$(255)
PackTxt = text$
Exit Function ' To indicate a packed String
Else
'text$ is packed so unpack it

comp$ = Right$(text$, Len(text$) - 1) 'remove CHR$(255)
text$ = ""'re-init text$
For x = 1 To Len(comp$)
Chars$ = Asc(Mid$(comp$, x, 1))
If Chars$ > 95 Then 'if char > 95 then char is the instr of the
' unpacked characters in Dict$, remember?

text$ = text$ + Mid$(Dict$, (Chars$ - 96) * 2 + 1, 2)
PackTxt = text$
Else 'if the characters weren't found In Dict$ they were stored
'value less than 95 (most are found, though)

text$ = text$ + Chr$(Asc(Mid$(comp$, x, 1)) + 32)
PackTxt = text$
End If
Next x
End If
PackTxt = text$
End Function