home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD4545452000.psc / TableDecoder.bas < prev    next >
Encoding:
BASIC Source File  |  2000-03-08  |  4.4 KB  |  140 lines

  1. Attribute VB_Name = "TableDecoder"
  2. Option Explicit
  3.  
  4. 'Takes sets of 4 characters (ASCII) and returns sets of 3 characters (binary)
  5. Private Function DecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  6.     Dim OutString As String
  7.     Dim i As Long
  8.     Dim CharArray()
  9.     Dim x0, x1, x2 As Long      'These are the chars that will be spit out
  10.     Dim y0, y1, y2, y3 As Long  'These are what we got in
  11.     
  12.     ReDim CharArray(Len(InString))
  13.     
  14.     For i = 1 To Len(InString) Step 4
  15.         y0 = Asc(Mid(InString, i, 1))           'Get 4 chars and put into 'y's
  16.         y1 = Asc(Mid(InString, i + 1, 1))
  17.         y2 = Asc(Mid(InString, i + 2, 1))
  18.         y3 = Asc(Mid(InString, i + 3, 1))
  19.         
  20.         If (y0 = 96) Then y0 = 32               'If char is 96 then set to 32
  21.         If (y1 = 96) Then y1 = 32
  22.         If (y2 = 96) Then y2 = 32
  23.         If (y3 = 96) Then y3 = 32
  24.         
  25.         x0 = ((y0 - 32) * 4) + ((y1 - 32) \ 16) 'Calculate the 3 chars
  26.         x1 = ((y1 Mod 16) * 16) + ((y2 - 32) \ 4)
  27.         x2 = ((y2 Mod 4) * 64) + (y3 - 32)
  28.         
  29.         OutString = OutString + Chr(x0) + Chr(x1) + Chr(x2)
  30.         'DoEvents
  31.     Next i
  32.     If Len(OutString) > Bytes Then
  33.         DecodeString = Left(OutString, Bytes)
  34.     Else
  35.         DecodeString = OutString
  36.     End If
  37. End Function
  38.  
  39. 'Takes sets of 3 characters (binary) and returns sets of 4 characters (ASCII)
  40. Private Function EncodeString(ByVal InString As String) As String
  41.     Dim OutString As String
  42.     
  43.     Dim i As Integer
  44.     
  45.     Dim y0, y1, y2, y3 As Integer
  46.     
  47.     Dim x0, x1, x2 As Integer
  48.     
  49.     'It's Very Important to pad the InString to make the len a multiple of 3.
  50.     'This can add 1 or 2 extra NULL character to the end of the file,
  51.     'resulting in a different file size. No harm, it's for easier
  52.     'implementation. We could chop the file back down, upon uudecoding...
  53.     If Len(InString) Mod 3 <> 0 Then
  54.         InString = InString & String(3 - Len(InString) Mod 3, Chr$(0))
  55.     End If
  56.     
  57.     For i = 1 To Len(InString) Step 3
  58.         x0 = Asc(Mid(InString, i, 1))
  59.         x1 = Asc(Mid(InString, i + 1, 1))
  60.         x2 = Asc(Mid(InString, i + 2, 1))
  61.         
  62.         y0 = (x0 \ 4 + 32)
  63.         y1 = ((x0 Mod 4) * 16) + (x1 \ 16 + 32)
  64.         y2 = ((x1 Mod 16) * 4) + (x2 \ 64 + 32)
  65.         y3 = (x2 Mod 64) + 32
  66.         
  67.         If (y0 = 32) Then y0 = 96
  68.         If (y1 = 32) Then y1 = 96
  69.         If (y2 = 32) Then y2 = 96
  70.         If (y3 = 32) Then y3 = 96
  71.         
  72.         OutString = OutString + Chr(y0) + Chr(y1) + Chr(y2) + Chr(y3)
  73.     Next i
  74.     EncodeString = OutString
  75. End Function
  76.  
  77. Sub MakeUUETable()
  78.     Dim i, j, k, l As Integer
  79.     Dim FilePos As Long
  80.     
  81.     'ProgForm.PBar.Value = 0
  82.     ProgForm.Show
  83.     Open "C:\Code\UU Class\Test Files\Table.uue" For Binary Access Write As #1
  84.     FilePos = 1
  85.     For i = 33 To 96
  86.         For j = 33 To 96
  87.             For k = 33 To 96
  88.                 For l = 33 To 96
  89.                     Put #1, FilePos, EncodeString(Chr(i) + Chr(j) + Chr(k) + Chr(l))
  90.                     FilePos = FilePos + 4
  91.                     DoEvents
  92.                 Next l
  93.             Next k
  94.         Next j
  95.         ProgForm.PBar.Value = i
  96.     Next i
  97.     Close #1
  98.     Unload ProgForm
  99. End Sub
  100.  
  101. Sub CheckVals()
  102.     Dim i As Long
  103.     Dim InByte As String * 1
  104.     Dim maxx, minn As Integer
  105.     
  106.     minn = 255: maxx = 0
  107.     ProgForm.PBar.Value = 0
  108.     ProgForm.Show
  109.     Open "C:\Code\UU Class\Test Files\Table.uue" For Binary Access Read As #1
  110.     ProgForm.PBar.Max = LOF(1)
  111.     For i = 1 To LOF(1)
  112.         Get #1, i, InByte
  113.         'If Asc(InByte) > maxx Then maxx = Asc(InByte)
  114.         If Asc(InByte) < minn Then minn = Asc(InByte)
  115.         DoEvents
  116.         ProgForm.PBar.Value = i
  117.     Next i
  118.     Close #1
  119.     Unload ProgForm
  120.     MsgBox "Max: " + Trim(Str(maxx)) + vbCrLf + "Min: " + Trim(Str(minn))
  121. End Sub
  122.  
  123. Sub MakeArray()
  124.     Dim DecodeArray(33 To 96, 33 To 96, 33 To 96, 33 To 96) As String * 3
  125.     Dim i, j, k, l As Integer
  126.     
  127.     ProgForm.Show
  128.     For i = 33 To 96
  129.         For j = 33 To 96
  130.             For k = 33 To 96
  131.                 For l = 33 To 96
  132.                     DecodeArray(i, j, k, l) = DecodeString(Chr(i) + Chr(j) + Chr(k) + Chr(l), 3)
  133.                     DoEvents
  134.                 Next l
  135.             Next k
  136.         Next j
  137.         ProgForm.PBar.Value = i
  138.     Next i
  139. End Sub
  140.