Loading

Base64 auth function

  1.  
  2. ' ### RK - 09/10/15 - Base64 encoding to include basic auth in the objHTTP header
  3. Function Base64Encode(inData)
  4.     Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  5.     Dim sOut, I
  6.     For I = 1 To Len(inData) Step 3
  7.         Dim nGroup, pOut
  8.         nGroup = &H10000 * Asc(Mid(inData, I, 1)) + &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
  9.         nGroup = Oct(nGroup)
  10.         nGroup = String(8 - Len(nGroup), "0") & nGroup
  11.         pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
  12.         sOut = sOut + pOut
  13.     Next
  14.     Select Case Len(inData) Mod 3
  15.         Case 1: '8 bit final
  16.             sOut = Left(sOut, Len(sOut) - 2) + "=="
  17.         Case 2: '16 bit final
  18.             sOut = Left(sOut, Len(sOut) - 1) + "="
  19.     End Select
  20.     Base64Encode = sOut
  21. End Function
  22. Function MyASC(OneChar)
  23.     If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
  24. End Function

Comments