home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / base641a / encoding.cls next >
Encoding:
Visual Basic class definition  |  1999-09-20  |  6.8 KB  |  162 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Encoding"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Private Base64Tab(63) As Byte
  15. Private DecodeTable(233) As Byte
  16. Public Sub Class_Initialize()
  17.     'initialize the base64 table
  18.     Dim tDecodeTable As Variant
  19.     tDecodeTable = Array("255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "62", "255", "255", "255", "63", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "255", "255", "255", "64", "255", "255", "255", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", _
  20.         "18", "19", "20", "21", "22", "23", "24", "25", "255", "255", "255", "255", "255", "255", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255" _
  21.         , "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255", "255")
  22.     For i = LBound(tDecodeTable) To UBound(tDecodeTable)
  23.         DecodeTable(i) = tDecodeTable(i)
  24.     Next
  25.     For i = 65 To 90
  26.         Base64Tab(i - 65) = i
  27.     Next
  28.     For i = 97 To 122
  29.         Base64Tab(i - 71) = i
  30.     Next
  31.     For i = 0 To 9
  32.         Base64Tab(i + 52) = 48 + i
  33.     Next
  34.     Base64Tab(62) = 43
  35.     Base64Tab(63) = 47
  36. End Sub
  37. Public Sub EncodeB64(ByRef FileIn() As Byte, ByRef Out() As Byte)
  38. 'declarations
  39. Dim bin(2) As Byte
  40. Dim iTemp As Long
  41. Dim i As Long
  42. Dim Lenght As Long
  43. Dim Remaining As Byte
  44. Dim BytesOut As Long
  45. Lenght = UBound(FileIn) + 1 'lenght of the string
  46. Remaining = ((Lenght) Mod 3)
  47. If Remaining = 0 Then
  48.     BytesOut = ((Lenght / 3) * 4)  ' how many bytes will the encoded string have
  49. Else
  50.     BytesOut = (((Lenght + (3 - Remaining)) / 3) * 4) ' how many bytes will the encoded string have
  51. End If
  52. ReDim Out(BytesOut - 1)
  53. For i = 0 To Lenght - Remaining - 1 Step 3
  54.     '3 bytes in
  55.     bin(0) = FileIn(i)
  56.     bin(1) = FileIn(i + 1)
  57.     bin(2) = FileIn(i + 2)
  58.     '4 bytes out
  59.     Out(iTemp) = Base64Tab((bin(0) \ 4) And &H3F)
  60.     Out(iTemp + 1) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
  61.     Out(iTemp + 2) = Base64Tab((bin(1) And &HF) * 4 Or (bin(2) \ 64) And &H3)
  62.     Out(iTemp + 3) = Base64Tab(bin(2) And &H3F)
  63.     iTemp = iTemp + 4
  64. Next
  65. If Remaining = 1 Then ' if there is 1 byte remaining
  66.     'read 1 byte, the second in 0
  67.     bin(0) = FileIn(UBound(FileIn))
  68.     bin(1) = 0
  69.     Out(UBound(Out) - 3) = Base64Tab((bin(0) \ 4) And &H3F)
  70.     Out(UBound(Out) - 2) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
  71.     Out(UBound(Out) - 1) = 61
  72.     Out(UBound(Out)) = 61
  73. ElseIf Remaining = 2 Then 'if there are 2 bytes remaining
  74.     'read 2 bytes, the third is 0
  75.     bin(0) = FileIn(UBound(FileIn) - 1)
  76.     bin(1) = FileIn(UBound(FileIn))
  77.     bin(2) = 0
  78.     Out(UBound(Out) - 3) = Base64Tab((bin(0) \ 4) And &H3F)
  79.     Out(UBound(Out) - 2) = Base64Tab((bin(0) And &H3) * 16 Or (bin(1) \ 16) And &HF)
  80.     Out(UBound(Out) - 1) = Base64Tab((bin(1) And &HF) * 4 Or (bin(2) \ 64) And &H3)
  81.     Out(UBound(Out)) = 61
  82. End If
  83. End Sub
  84. Public Sub Str2ByteArray(StringIn As String, ByteArray() As Byte)
  85.     ByteArray = StrConv(StringIn, vbFromUnicode)
  86. End Sub
  87. Public Sub Span(CharsPerLine As Long, InArray() As Byte, OutArray() As Byte)
  88. Dim Lines As Long
  89. Dim i2 As Long
  90. Dim i As Long
  91. Dim TempI As Long
  92. Lines = ((UBound(InArray) + 1) + (UBound(InArray) + 1) Mod CharsPerLine) / CharsPerLine
  93. ReDim OutArray(LBound(InArray) To UBound(InArray) + (Lines * 2))
  94. TempI = 0
  95. While Not TempI > UBound(InArray)
  96.     For i = TempI To TempI + CharsPerLine - 1
  97.         If i2 > UBound(OutArray) Or i > UBound(InArray) Then Exit Sub
  98.         OutArray(i2) = InArray(i)
  99.         i2 = i2 + 1
  100.     Next
  101.     If i2 > UBound(OutArray) Then Exit Sub
  102.     OutArray(i2) = 13
  103.     OutArray(i2 + 1) = 10
  104.     TempI = TempI + CharsPerLine
  105.     i2 = i2 + 2
  106. Wend
  107. End Sub
  108. Public Sub DecodeB64(ByRef FileIn() As Byte, ByRef Out() As Byte)
  109. 'declarations
  110. Dim inp(3) As Byte
  111. Dim iTemp As Long
  112. Dim i As Long
  113. Dim Lenght As Long
  114. Dim Remaining As Byte
  115. Dim BytesOut As Long
  116. Dim lTemp2 As Long
  117. If FileIn(UBound(FileIn)) = 61 Then
  118.     Remaining = 1
  119.     If FileIn(UBound(FileIn) - 1) = 61 Then
  120.         Remaining = 2
  121.     End If
  122. End If
  123. Lenght = UBound(FileIn) + 1 'lenght of the string
  124. BytesOut = ((Lenght / 4) * 3) - Remaining ' how many bytes will the decoded string have
  125. ReDim Out(BytesOut - 1)
  126. For i = 0 To Lenght Step 4
  127.     inp(0) = DecodeTable(FileIn(i))
  128.     inp(1) = DecodeTable(FileIn(i + 1))
  129.     inp(2) = DecodeTable(FileIn(i + 2))
  130.     inp(3) = DecodeTable(FileIn(i + 3))
  131.     If inp(3) = 64 Or inp(2) = 64 Then
  132.         If inp(3) = 64 And Not (inp(2) = 64) Then
  133.             inp(0) = DecodeTable(FileIn(i))
  134.             inp(1) = DecodeTable(FileIn(i + 1))
  135.             inp(2) = DecodeTable(FileIn(i + 2))
  136.             '2 bytes out
  137.             Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  138.             Out(iTemp + 1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
  139.             Exit Sub
  140.         ElseIf inp(2) = 64 Then
  141.             inp(0) = DecodeTable(FileIn(i))
  142.             inp(1) = DecodeTable(FileIn(i + 1))
  143.             '1 byte out
  144.             Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  145.             Exit Sub
  146.         End If
  147.     End If
  148.     '3 bytes out
  149.     Out(iTemp) = (inp(0) * 4) Or ((inp(1) \ 16) And &H3)
  150.     Out(iTemp + 1) = ((inp(1) And &HF) * 16) Or ((inp(2) \ 4) And &HF)
  151.     Out(iTemp + 2) = ((inp(2) And &H3) * 64) Or inp(3)
  152.     iTemp = iTemp + 3
  153. Next
  154. End Sub
  155.  
  156. Public Sub Unspan(ArrayIn() As Byte, ArrayOut() As Byte)
  157.     Dim sTemp As String
  158.     sTemp = StrConv(ArrayIn, vbUnicode)
  159.     sTemp = Replace(sTemp, vbCrLf, "")
  160.     ArrayOut = StrConv(sTemp, vbFromUnicode)
  161. End Sub
  162.