Stefan Thoolen .nl | VB6 Function Database

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

''
' Round fractions up
' Same syntax as the PHP function 'ceil'
' See also: http://www.php.net/manual/en/function.ceil.php
' @param    Double  value       The nummeric value
' @return   Integer             A ceiled value
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function ceil(value As Double) As Integer
    Dim i As Integer: i = Round(value)
    If i < value Then i = i + 1
    ceil = i
End Function

''
' 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

''
' Uuencode a string
' Same syntax as the PHP function 'convert_uuencode'
' See also: http://www.php.net/manual/en/function.convert-uuencode.php
' @param    String  str         The text/plain version of a string
' @return   String              A uuencoded presentation of the string
' @author   Stefan Thoolen <mail@stefanthoolen.nl>
Public Function convert_uuencode(str As String) As String
    Dim i As Integer, j As Integer, s As String, t As String
    Dim binstr As String, retval As String
    
    ' Takes blocks of 3 bytes
    For i = 1 To ceil(Len(str) / 3) * 3 Step 3
        s = Mid(str, i, 3)
        s = s & String(3 - Len(s), Chr(0)) '& s
        t = decbin(Asc(Mid(s, 1, 1))): t = String(8 - Len(t), "0") & t: binstr = binstr & t
        t = decbin(Asc(Mid(s, 2, 1))): t = String(8 - Len(t), "0") & t: binstr = binstr & t
        t = decbin(Asc(Mid(s, 3, 1))): t = String(8 - Len(t), "0") & t: binstr = binstr & t
    Next i
    
    s = ""
    For i = 1 To Len(binstr) Step 6
        s = s & Chr(bindec(Mid(binstr, i, 6)) + 32)
    Next i
    binstr = s
    For i = 1 To Len(binstr) Step 60
        s = Mid(binstr, i, 60)
        If Len(s) = 60 Then
            t = Chr(77)
        Else
            j = Len(str) - (floor(Len(str) / 45) * 45)
            t = Chr(j + 32)
        End If
        retval = retval & t & s & Chr(10)
    Next i
    convert_uuencode = Replace(retval & " ", " ", Chr(96))
End Function
Visual Basic 6 function "convert_uuencode"

Go back
