Stefan Thoolen .nl | VB6 Function Database

Attribute VB_Name = "modBase64Encode"
' 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

''
' Encodes a string to base64 a string
' Same syntax as the PHP function 'base64_encode'
' See also: http://www.php.net/manual/en/function.base64-encode.php
' @param    String  encoded_data    The text/plain data
' @return   String                  A BASE64 encoded version
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function base64_encode(data As String) As String
    Dim BASE64TABLE As String
    BASE64TABLE = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    Dim i As Long, retval As String
    Dim byte1 As String, byte2 As String, byte3 As String, pair As String
    Dim newbyte1 As Integer, newbyte2 As Integer, newbyte3 As Integer, newbyte4 As Integer
    For i = 1 To Len(data) Step 3
        If Len(data) >= i + 0 Then byte1 = decbin(Asc(Mid(data, i + 0, 1))) Else byte1 = "0"
        If Len(data) >= i + 1 Then byte2 = decbin(Asc(Mid(data, i + 1, 1))) Else byte2 = "0"
        If Len(data) >= i + 2 Then byte3 = decbin(Asc(Mid(data, i + 2, 1))) Else byte3 = "0"
        pair = String(8 - Len(byte1), "0") & byte1 & String(8 - Len(byte2), "0") & byte2 & String(8 - Len(byte3), "0") & byte3
        newbyte1 = bindec(Mid(pair, 1, 6))
        newbyte2 = bindec(Mid(pair, 7, 6))
        newbyte3 = bindec(Mid(pair, 13, 6))
        newbyte4 = bindec(Mid(pair, 19, 6))
        If i + 0 > Len(data) Then newbyte2 = 64: newbyte3 = 64: newbyte4 = 64
        If i + 1 > Len(data) Then newbyte3 = 64: newbyte4 = 64
        If i + 2 > Len(data) Then newbyte4 = 64
        retval = retval & Mid(BASE64TABLE, newbyte1 + 1, 1)
        retval = retval & Mid(BASE64TABLE, newbyte2 + 1, 1)
        retval = retval & Mid(BASE64TABLE, newbyte3 + 1, 1)
        retval = retval & Mid(BASE64TABLE, newbyte4 + 1, 1)
    Next i
    base64_encode = retval
End Function
Visual Basic 6 function "base64_encode"

Go back
