Stefan Thoolen .nl | VB6 Function Database

Attribute VB_Name = "modBase64Decode"
' These functions are downloaded from:
' http://www.stefanthoolen.nl/archive/vb6-functions/
' 
' You may freely distribute this file but please leave all comments, including this one, in it.
' 
' @Author Stefan Thoolen <mail@stefanthoolen.nl>

Option Explicit

''
' Makes a binary string from an integer number
' Same syntax as the PHP function 'decbin'
' See also: http://www.php.net/manual/en/function.decbin.php
' @param    Integer number          The decimal value
' @return   String                  A binary presentation of the number (ex.: 00100111)
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function decbin(ByVal number As Integer) As String
    Dim retval As String
    Do Until number = 0
        If (number Mod 2) Then retval = "1" & retval Else retval = "0" & retval
        number = number \ 2
    Loop
    decbin = retval
End Function

''
' Makes an integer number from a binary string
' Same syntax as the PHP function 'bindec'
' See also: http://www.php.net/manual/en/function.bindec.php
' @param    String  binary_string   The binary string (ex.: 00100111)
' @return   Integer                 A decimal presentation of the binary value
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function bindec(binary_string As String) As Long
    Dim i As Integer, pos As Integer, ret As Long
    For i = 1 To Len(binary_string)
        pos = Len(binary_string) - i
        If Mid(binary_string, pos + 1, 1) = "1" Then ret = ret + (2 ^ (i - 1))
    Next i
    bindec = ret
End Function

''
' Decodes a base64 string to a data string
' Same syntax as the PHP function 'base64_decode'
' See also: http://www.php.net/manual/en/function.base64-decode.php
' @param    String  encoded_data    The BASE64 encoded data
' @return   String                  A text/plain version
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function base64_decode(encoded_data As String) As String
    Dim BASE64TABLE As String
    BASE64TABLE = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    Dim i As Long, j As Long, s As String, retval As String, minus As Integer
    Dim byte1 As String, byte2 As String, byte3 As String, byte4 As String, pair As String
    Dim encoded_data_stripped As String
    For i = 1 To Len(encoded_data)
        s = Mid(encoded_data, i, 1)
        If s = Chr(13) Or s = Chr(10) Then s = ""
        encoded_data_stripped = encoded_data_stripped & s
    Next i
    minus = 0
    For i = 1 To Len(encoded_data_stripped) Step 4
        For j = 1 To Len(BASE64TABLE)
            If Mid(encoded_data_stripped, i + 0, 1) = Mid(BASE64TABLE, j, 1) Then byte1 = decbin(j - 1)
            If Mid(encoded_data_stripped, i + 1, 1) = Mid(BASE64TABLE, j, 1) Then byte2 = decbin(j - 1)
            If Mid(encoded_data_stripped, i + 2, 1) = Mid(BASE64TABLE, j, 1) Then byte3 = decbin(j - 1)
            If Mid(encoded_data_stripped, i + 3, 1) = Mid(BASE64TABLE, j, 1) Then byte4 = decbin(j - 1)
        Next j
        If byte2 = "1000000" Then minus = minus + 1: byte2 = 0
        If byte3 = "1000000" Then minus = minus + 1: byte3 = 0
        If byte4 = "1000000" Then minus = minus + 1: byte4 = 0
        pair = String(6 - Len(byte1), "0") & byte1 & String(6 - Len(byte2), "0") & byte2 & String(6 - Len(byte3), "0") & byte3 & String(6 - Len(byte4), "0") & byte4
        retval = retval & Chr(bindec(Val(Mid(pair, 1, 8))))
        retval = retval & Chr(bindec(Val(Mid(pair, 9, 8))))
        retval = retval & Chr(bindec(Val(Mid(pair, 17, 8))))
    Next i
    base64_decode = Left(retval, Len(retval) - minus)
End Function
Visual Basic 6 function "base64_decode"

Go back
