Создание (+распаковка) CAB архива

    
    Private Sub TestStringEncodeToBase222()
        cbBaseXEncode = AddressOf BaseXEncode_Init
        
        Dim s As String = "Какая-то очень длинная строка"
        Dim s1 As String = ToAnsi(s)
        Dim s2 As String = StringToBase222(s1)
        Dim b() As Byte = s1
        Dim s3 As String = BytesToBase64(b)
        
        Debug.Print s ; vbCr ; s2 ; vbCr ; s3
        Debug.Print LenB(s) ; LenB(s2) ; LenB(s3)
    End Sub 
    
    Private Function StringToBase222(sInp As String) As String
        Dim strSz&, llBuf^(), i& ', llbufSz&
        Dim sOut$
        strSz = LenB(sInp)
        i = (strSz - 1) \ 8
        ReDim llBuf(i) 'Lenb(Of LongLong)
        vbaCopyBytes strSz, VarPtr(llBuf(0)), StrPtr(sInp)
        For i = 0 To i
            sOut = sOut & "," & cbBaseXEncode(llBuf(i), 222)
        Next
        
        Return sOut
    End Function
    
    Private Function BytesToBase64(varBytes() As Byte) As String
        With CreateObject("MSXML2.DomDocument").createElement("b64")
            .DataType = "bin.base64"
            .nodeTypedValue = varBytes
            BytesToBase64 = Replace(.text, vbLf, "")
        End With
    End Function
    
    Function BaseXEncode_Init(ByVal llNum As LongLong, ByVal Base As Long) As String
        Static Init As Boolean
        If Init Then
        Else
            Dim i&
            Dim sChrRng As String = _
            "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/=!""#$%&'()*,-.:;<>?@[\]^_`{|}~ ЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџЎўЈ¤Ґ¦§Ё©Є«¬­®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
            CopyMemory ChrTbl(0), ByVal StrPtr(sChrRng), MaxBase * 2
            Init = True
        End If
        cbBaseXEncode = AddressOf BaseXEncode
        Return BaseXEncode(llNum, Base)
    End Function
    Function BaseXEncode(ByVal llNum As LongLong, ByVal Base As Long) As String
        Const MaxIndex = 65
        Select Case Base
        Case 0 To MaxBase
        Case Else: Exit Function
        End Select
        Dim iAr%(MaxIndex), i As Long = MaxIndex, strLen&
        Dim blMinus As Boolean
        If llNum < 0 Then llNum = -llNum: blMinus = True
        Do
            iAr(i) = ChrTbl(CLng(llNum Mod Base))
            i -= 1
            llNum = llNum \ Base
        Loop While llNum
        If blMinus Then iAr(i) = 45: i -= 1
        strLen = MaxIndex - i
        
        BaseXEncode = String$(strLen, vbNullChar)
        vbaCopyBytes(strLen * 2, StrPtr(BaseXEncode), VarPtr(iAr(i + 1)))
    End Function    
    Private Function ToAnsi$(Str$)
        ToAnsi = StrConv(Str, vbFromUnicode)
    End Function