Advertisement
Guest User

Base64 Encoeder

a guest
Jan 30th, 2015
316
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.63 KB | None | 0 0
  1. dim s
  2. s = inputbox("Set Text")
  3. dim x
  4. set x = CreateObject("Scripting.FilesystemObject")
  5. dir = WScript.ScriptFullname
  6. dim f
  7. set f = x.opentextfile(dir & "_ENCODED.txt",2,True,false)
  8. f.write (Base64Encode(s))
  9. Function Base64Encode(inData)
  10. 'rfc1521
  11. '2001 Antonin Foller, Motobit Software, http://Motobit.cz
  12. Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  13. Dim cOut, sOut, I
  14.  
  15. 'For each group of 3 bytes
  16. For I = 1 To Len(inData) Step 3
  17. Dim nGroup, pOut, sGroup
  18.  
  19. 'Create one long from this 3 bytes.
  20. nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
  21. &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
  22.  
  23. 'Oct splits the long To 8 groups with 3 bits
  24. nGroup = Oct(nGroup)
  25.  
  26. 'Add leading zeros
  27. nGroup = String(8 - Len(nGroup), "0") & nGroup
  28.  
  29. 'Convert To base64
  30. pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
  31. Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
  32. Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
  33. Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
  34.  
  35. 'Add the part To OutPut string
  36. sOut = sOut + pOut
  37.  
  38. 'Add a new line For Each 76 chars In dest (76*3/4 = 57)
  39. 'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  40. Next
  41. Select Case Len(inData) Mod 3
  42. Case 1: '8 bit final
  43. sOut = Left(sOut, Len(sOut) - 2) + "=="
  44. Case 2: '16 bit final
  45. sOut = Left(sOut, Len(sOut) - 1) + "="
  46. End Select
  47. Base64Encode = sOut
  48. End Function
  49.  
  50. Function MyASC(OneChar)
  51. If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
  52. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement