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 / DecodeTester.bas < prev    next >
Encoding:
BASIC Source File  |  2000-03-08  |  5.2 KB  |  146 lines
  1. Attribute VB_Name = "DecodeTester"
  2. Option Explicit
  3.  
  4. Dim asctime, checktime, calctime, chrtime As Single
  5. Dim TimeHolder As Single
  6.  
  7. 'Takes sets of 4 characters (ASCII) and returns sets of 3 characters (binary)
  8. Private Function DecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  9.     Dim OutString As String
  10.     Dim i As Long
  11.     
  12.     Dim x0, x1, x2 As Long   'These are the chars that will be spit out
  13.     Dim y0, y1, y2, y3 As Long   'These are what we got in
  14.     
  15.     For i = 1 To Len(InString) Step 4
  16.         y0 = Asc(Mid(InString, i, 1))           'Get 4 chars and put into 'y's
  17.         y1 = Asc(Mid(InString, i + 1, 1))
  18.         y2 = Asc(Mid(InString, i + 2, 1))
  19.         y3 = Asc(Mid(InString, i + 3, 1))
  20.         
  21.         If (y0 = 96) Then y0 = 32               'If char is 96 then set to 32
  22.         If (y1 = 96) Then y1 = 32
  23.         If (y2 = 96) Then y2 = 32
  24.         If (y3 = 96) Then y3 = 32
  25.         
  26.         x0 = ((y0 - 32) * 4) + ((y1 - 32) \ 16) 'Calculate the 3 chars
  27.         x1 = ((y1 Mod 16) * 16) + ((y2 - 32) \ 4)
  28.         x2 = ((y2 Mod 4) * 64) + (y3 - 32)
  29.         
  30.         Select Case Bytes
  31.             Case 2
  32.                 OutString = OutString + Chr(x0) + Chr(x1)
  33.             Case 1
  34.                 OutString = OutString + Chr(x0)
  35.             Case Else
  36.                 OutString = OutString + Chr(x0) + Chr(x1) + Chr(x2)
  37.         End Select
  38.         Bytes = Bytes - 3
  39.     Next i
  40.     DecodeString = OutString
  41. End Function
  42.  
  43. 'Takes sets of 4 characters (ASCII) and returns sets of 3 characters (binary)
  44. Private Function FastDecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  45.     Dim OutString As String
  46.     Dim i As Long
  47.     
  48.     Dim x0, x1, x2 As Long   'These are the chars that will be spit out
  49.     Dim y0, y1, y2, y3 As Long   'These are what we got in
  50.     
  51.     For i = 1 To Len(InString) Step 4
  52.         y0 = Asc(Mid(InString, i, 1))           'Get 4 chars and put into 'y's
  53.         y1 = Asc(Mid(InString, i + 1, 1))
  54.         y2 = Asc(Mid(InString, i + 2, 1))
  55.         y3 = Asc(Mid(InString, i + 3, 1))
  56.         
  57.         If (y0 = 96) Then y0 = 32               'If char is 96 then set to 32
  58.         If (y1 = 96) Then y1 = 32
  59.         If (y2 = 96) Then y2 = 32
  60.         If (y3 = 96) Then y3 = 32
  61.         
  62.         x0 = ((y0 - 32) * 4) + ((y1 - 32) \ 16) 'Calculate the 3 chars
  63.         x1 = ((y1 Mod 16) * 16) + ((y2 - 32) \ 4)
  64.         x2 = ((y2 Mod 4) * 64) + (y3 - 32)
  65.         
  66.         OutString = OutString + Chr(x0) + Chr(x1) + Chr(x2)
  67.     Next i
  68.     If Len(OutString) > Bytes Then
  69.         FastDecodeString = Left(OutString, Bytes)
  70.     Else
  71.         FastDecodeString = OutString
  72.     End If
  73. End Function
  74.  
  75. 'Takes sets of 4 characters (ASCII) and returns sets of 3 characters (binary)
  76. Private Function NewDecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  77.     Dim OutString As String
  78.     Dim i As Long
  79.     
  80.     Dim x0, x1, x2 As Long   'These are the chars that will be spit out
  81.     Dim y0, y1, y2, y3 As Long   'These are what we got in
  82.     
  83.     For i = 1 To Len(InString) Step 4
  84.         y0 = Asc(Mid(InString, i, 1))           'Get 4 chars and put into 'y's
  85.         y1 = Asc(Mid(InString, i + 1, 1))
  86.         y2 = Asc(Mid(InString, i + 2, 1))
  87.         y3 = Asc(Mid(InString, i + 3, 1))
  88.         
  89.         'If (y0 = 96) Then y0 = 32               'If char is 96 then set to 32
  90.         'If (y1 = 96) Then y1 = 32
  91.         'If (y2 = 96) Then y2 = 32
  92.         'If (y3 = 96) Then y3 = 32
  93.        
  94.         'x0 = ((y0 - 32) * 4) + ((y1 - 32) \ 16) 'Calculate the 3 chars
  95.         'x1 = ((y1 Mod 16) * 16) + ((y2 - 32) \ 4)
  96.         'x2 = ((y2 Mod 4) * 64) + (y3 - 32)
  97.         
  98.         y0 = y0 - 32
  99.         y1 = y1 - 32
  100.         y2 = y2 - 32
  101.         y3 = y3 - 32
  102.         
  103.         x0 = ((y0 And 63) * 2 ^ 2) Or ((y1 And 48) / 2 ^ 4)
  104.         x1 = ((y1 And 15) * 2 ^ 4) Or ((y2 And 60) / 2 ^ 2)
  105.         x2 = ((y2 And 3) * 2 ^ 6) Or ((y3 And 63))
  106.         
  107.         OutString = OutString + Chr(x0) + Chr(x1) + Chr(x2)
  108.     Next i
  109.     If Len(OutString) > Bytes Then
  110.         NewDecodeString = Left(OutString, Bytes)
  111.     Else
  112.         NewDecodeString = OutString
  113.     End If
  114. End Function
  115.  
  116. Private Sub DecodeTest()
  117.     Dim TimeHolder As Single
  118.     Dim i As Integer
  119.     Dim dummy As String
  120.     Dim slowtime, fasttime As Single
  121.     
  122.     TimeHolder = Timer
  123.     For i = 1 To 25000
  124.         dummy = FastDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  125.     Next i
  126.     slowtime = Timer - TimeHolder
  127.     
  128.     TimeHolder = Timer
  129.     For i = 1 To 25000
  130.         dummy = NewDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  131.     Next i
  132.     fasttime = Timer - TimeHolder
  133.     
  134.     MsgBox "Old decode: " + Trim(Str(slowtime)) + vbCrLf + "New decode: " + Trim(Str(fasttime))
  135. End Sub
  136.  
  137. Sub DecodeTimes()
  138.     Dim i As Integer
  139.     Dim dummy As String
  140.     
  141.     For i = 1 To 25000
  142.         dummy = FastDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  143.     Next i
  144.     MsgBox "Asc() time: " + Trim(Str(asctime)) + vbCrLf + "Check time: " + Trim(Str(checktime)) + vbCrLf + "Calc time: " + Trim(Str(calctime)) + vbCrLf + "Chr() time: " + Trim(Str(chrtime))
  145. End Sub
  146.