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 / ArrayEncode.bas < prev    next >
Encoding:
BASIC Source File  |  2000-03-08  |  4.1 KB  |  113 lines
  1. Attribute VB_Name = "ArrayEncode"
  2. Option Explicit
  3.  
  4. Public Declare Sub RtlMoveMemory Lib "kernel32.dll" (dst As Any, src As Any, ByVal cb As Long)
  5.  
  6. Public Sub StringToByteArray(ByVal StringIn As String, ByteArray() As Byte)
  7.     Dim lBytes As Long
  8.     
  9.     If Len(StringIn) = 0 Then Exit Sub
  10.     lBytes = Len(StringIn)
  11.     ReDim ByteArray(lBytes - 1)
  12.     
  13.     RtlMoveMemory ByteArray(0), ByVal StringIn, lBytes
  14. End Sub
  15.  
  16. Public Sub ByteArrayToString(ByteArray() As Byte, StringOut As String)
  17.   Dim lBytes As Long
  18.  
  19.   If LBound(ByteArray) > 0 Then Exit Sub ' lBound MUST be 0
  20.   lBytes = UBound(ByteArray) + 1
  21.   StringOut = String$(lBytes, 0)
  22.   
  23.   RtlMoveMemory ByVal StringOut, ByteArray(0), lBytes
  24. End Sub
  25.  
  26. Private Function ArrayDecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  27.     Dim OutString As String
  28.     Dim i As Long
  29.     Dim UnCodedArray() As Byte
  30.     Dim CodedArray() As Byte
  31.     
  32.     StringToByteArray InString, UnCodedArray()
  33.     ReDim CodedArray((Len(InString) / 4) * 3)
  34.     
  35.     For i = 0 To (Len(InString) / 4) - 1  'would be 0 to 14
  36.         If (UnCodedArray(i * 4 + 0) = 96) Then UnCodedArray(i * 4 + 0) = 32         'If char is 96 then set to 32
  37.         If (UnCodedArray(i * 4 + 1) = 96) Then UnCodedArray(i * 4 + 1) = 32
  38.         If (UnCodedArray(i * 4 + 2) = 96) Then UnCodedArray(i * 4 + 2) = 32
  39.         If (UnCodedArray(i * 4 + 3) = 96) Then UnCodedArray(i * 4 + 3) = 32
  40.         
  41.         CodedArray(i * 3 + 0) = ((UnCodedArray(i * 4 + 0) - 32) * 4) + ((UnCodedArray(i * 4 + 1) - 32) \ 16) 'Calculate the 3 chars
  42.         CodedArray(i * 3 + 1) = ((UnCodedArray(i * 4 + 1) Mod 16) * 16) + ((UnCodedArray(i * 4 + 2) - 32) \ 4)
  43.         CodedArray(i * 3 + 2) = ((UnCodedArray(i * 4 + 2) Mod 4) * 64) + (UnCodedArray(i * 4 + 3) - 32)
  44.     Next i
  45.     ByteArrayToString CodedArray(), OutString
  46.     ArrayDecodeString = Left(OutString, Bytes)
  47. End Function
  48.  
  49. 'Takes sets of 4 characters (ASCII) and returns sets of 3 characters (binary)
  50. Private Function FastDecodeString(ByVal InString As String, ByVal Bytes As Long) As String
  51.     Dim OutString As String
  52.     Dim i As Long
  53.     
  54.     Dim x0, x1, x2 As Long   'These are the chars that will be spit out
  55.     Dim y0, y1, y2, y3 As Long   'These are what we got in
  56.     
  57.     For i = 1 To Len(InString) Step 4
  58.         y0 = Asc(Mid(InString, i, 1))           'Get 4 chars and put into 'y's
  59.         y1 = Asc(Mid(InString, i + 1, 1))
  60.         y2 = Asc(Mid(InString, i + 2, 1))
  61.         y3 = Asc(Mid(InString, i + 3, 1))
  62.         
  63.         If (y0 = 96) Then y0 = 32               'If char is 96 then set to 32
  64.         If (y1 = 96) Then y1 = 32
  65.         If (y2 = 96) Then y2 = 32
  66.         If (y3 = 96) Then y3 = 32
  67.         
  68.         x0 = ((y0 - 32) * 4) + ((y1 - 32) \ 16) 'Calculate the 3 chars
  69.         x1 = ((y1 Mod 16) * 16) + ((y2 - 32) \ 4)
  70.         x2 = ((y2 Mod 4) * 64) + (y3 - 32)
  71.         
  72.         OutString = OutString + Chr(x0) + Chr(x1) + Chr(x2)
  73.     Next i
  74.     If Len(OutString) > Bytes Then
  75.         FastDecodeString = Left(OutString, Bytes)
  76.     Else
  77.         FastDecodeString = OutString
  78.     End If
  79. End Function
  80.  
  81. Sub atest()
  82.     Dim dec1 As String
  83.     Dim dec2 As String
  84.     
  85.     dec1 = FastDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  86.     dec2 = ArrayDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  87.     
  88.     If dec1 <> dec2 Then MsgBox "Decode Error!"
  89.     
  90. End Sub
  91.  
  92. Sub ADecodeTest()
  93.     Dim TimeHolder As Single
  94.     Dim i As Integer
  95.     Dim dummy As String
  96.     Dim slowtime, fasttime As Single
  97.     
  98.     TimeHolder = Timer
  99.     For i = 1 To 25000
  100.         dummy = FastDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  101.     Next i
  102.     slowtime = Timer - TimeHolder
  103.     
  104.     TimeHolder = Timer
  105.     For i = 1 To 25000
  106.         dummy = ArrayDecodeString("_P``_P```/__`/\```#_`/\`__\``/___P``````````````````````````", 45)
  107.     Next i
  108.     fasttime = Timer - TimeHolder
  109.     
  110.     MsgBox "Fast decode: " + Trim(Str(slowtime)) + vbCrLf + "Array decode: " + Trim(Str(fasttime))
  111. End Sub
  112.  
  113.