home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1778.psc / Base64.bas next >
Encoding:
BASIC Source File  |  1999-11-10  |  2.2 KB  |  67 lines
  1. Attribute VB_Name = "Base64"
  2. Const Base64Chars$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  3.  
  4. Public Function Base64Encode(ByVal filepath As String) As String
  5.     Open filepath For Binary As #1
  6.     
  7.     If LOF(1) - Loc(1) > 20000 Then
  8.         InBuffer$ = String$(20000, 0)
  9.     Else
  10.         InBuffer$ = String$(LOF(1) - Loc(1), 0)
  11.     End If
  12.     Get #1, , InBuffer$
  13.     Base64Encode = encode(InBuffer$)
  14.     
  15.     Close #1
  16. End Function
  17.  
  18. Public Function Base64Decode(ByVal data As String) As String
  19.     Base64Decode = decode(data)
  20. End Function
  21.  
  22. Private Function decode$(ss$)
  23.    If Len(ss$) Mod 4 > 0 Then ss$ = ss$ + String$(4 - (Len(ss$) Mod 4), " ")
  24.  
  25.    p% = 0
  26.    tt$ = ""
  27.    For i = 1 To Len(ss$) Step 4
  28.       t$ = "   "
  29.       s$ = Mid$(ss$, i, 4)
  30.       Byte1% = InStr(Base64Chars$, Mid$(s$, 1, 1)) - 1
  31.       Byte2% = InStr(Base64Chars$, Mid$(s$, 2, 1)) - 1
  32.       Byte3% = InStr(Base64Chars$, Mid$(s$, 3, 1)) - 1
  33.       Byte4% = InStr(Base64Chars$, Mid$(s$, 4, 1)) - 1
  34.  
  35.       Mid$(t$, 1, 1) = Chr$(((Byte2% And 48) \ 16) Or (Byte1% * 4) And &HFF)
  36.       Mid$(t$, 2, 1) = Chr$(((Byte3% And 60) \ 4) Or (Byte2% * 16) And &HFF)
  37.       Mid$(t$, 3, 1) = Chr$((((Byte3% And 3) * 64) And &HFF) Or (Byte4% And 63))
  38.  
  39.       tt$ = tt$ + t$
  40.       p% = p% + 1: If p% >= 19 Then p% = 0: ss$ = Mid$(ss$, 2)
  41.     Next i
  42.    decode$ = tt$
  43. End Function
  44.  
  45. Private Function encode$(ss$)
  46.    If Len(ss$) Mod 3 > 0 Then ss$ = ss$ + String$(3 - (Len(ss$) Mod 3), " ")
  47.    
  48.    p% = 0
  49.    tt$ = ""
  50.    For i = 1 To Len(ss$) Step 3
  51.       t$ = "    "
  52.       s$ = Mid$(ss$, i, 3)
  53.       
  54.       Char1% = Asc(Mid$(s$, 1, 1)): SaveBits1% = Char1% And 3
  55.       Char2% = Asc(Mid$(s$, 2, 1)): SaveBits2% = Char2% And 15
  56.       Char3% = Asc(Mid$(s$, 3, 1))
  57.       
  58.       Mid$(t$, 1) = Mid$(Base64Chars$, ((Char1% And 252) \ 4) + 1, 1)
  59.       Mid$(t$, 2) = Mid$(Base64Chars$, (((Char2% And 240) \ 16) Or (SaveBits1% * 16) And &HFF) + 1, 1)
  60.       Mid$(t$, 3) = Mid$(Base64Chars$, (((Char3% And 192) \ 64) Or (SaveBits2% * 4) And &HFF) + 1, 1)
  61.       Mid$(t$, 4) = Mid$(Base64Chars$, (Char3% And 63) + 1, 1)
  62.       tt$ = tt$ + t$
  63.       p% = p% + 1: If p% >= 19 Then p% = 0: tt$ = tt$ & vbCrLf
  64.    Next
  65.    encode$ = tt$
  66. End Function
  67.