VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 2  'vbComplexBound
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "myVBDll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Base 0

Private Declare Function BitAnd Lib "MyVCdll.dll" _
                        (ByVal nFirstNum As Long, _
                         ByVal nSecondNum As Long) As Long

Private Declare Function BitLeftShift Lib "MyVCdll.dll" _
                        (ByVal nFirstNum As Long, _
                         ByVal nSecondNum As Integer) As Long

Private Declare Function BitRightShift Lib "MyVCdll.dll" _
                        (ByVal nFirstNum As Long, _
                         ByVal nSecondNum As Integer) As Long

Public Function vbBitAnd(ByVal nFirstNum As Long, ByVal nSecondNum As Long) As Long
    vbBitAnd = BitAnd(nFirstNum, nSecondNum)
End Function

Public Function vbBitLeftShift(ByVal nFirstNum As Long, ByVal nSecondNum As Integer) As Long
    vbBitLeftShift = BitLeftShift(nFirstNum, nSecondNum)
End Function

Public Function vbBitRightShift(ByVal nFirstNum As Long, ByVal nSecondNum As Integer) As Long
    vbBitRightShift = BitRightShift(nFirstNum, nSecondNum)
End Function

'7-bit解碼
'strInput: 源編碼串
'返回: 目標字符串
Public Function Decode7BitASC(ByVal strInput As String) As String

    Dim iTmp    As Integer
    Dim iSrc()  As Integer
    Dim iDst()  As Integer
    
    Dim idxSrc      As Long      '源字符串的計數值
    Dim idxDst      As Long      '目標解碼串的計數值
    Dim idxByte     As Long      '當前正在處理的組內字節的序號，范圍是0-6
    Dim iLeft       As Long      '上一字節殘余的數據
    Dim nD          As Long

    Dim blReturn        As Boolean
    Dim strMyString()   As String
    Dim strOutput       As String

    On Error Resume Next
    
    blReturn = String2Array(strInput, " ", nD, strMyString(), True)

    ReDim iSrc(0 To nD)
    ReDim iDst(0 To nD * 2)

    For idxSrc = 0 To nD - 1
        iSrc(idxSrc) = Hex2Dec(strMyString(idxSrc))
    Next idxSrc

    '計數值初始化
    idxSrc = 0
    idxDst = 0

    '組內字節序號和殘余數據初始化
    idxByte = 0
    iLeft = 0

    '將源數據每7個字節分為一組，解壓縮成8個字節
    '循環該處理過程，直至源數據被處理完
    '如果分組不到7字節，也能正確處理
    While idxSrc < nD

        '將源字節右邊部分與殘余數據相加，去掉最高位，得到一個目標解碼字節
        iTmp = BitLeftShift(iSrc(idxSrc), idxByte)
        iTmp = iTmp Or iLeft
        iDst(idxDst) = iTmp And &H7F

        '將該字節剩下的左邊部分，作為殘余數據保存起來
        iLeft = BitRightShift(iSrc(idxSrc), (7 - idxByte))

        '修改目標串的指針和計數值
        idxDst = idxDst + 1

        '修改字節計數值
        idxByte = idxByte + 1

        '到了一組的最后一個字節
        If idxByte = 7 Then

            '額外得到一個目標解碼字節
            iDst(idxDst) = iLeft

            '修改目標串的指針和計數值
            idxDst = idxDst + 1

            '組內字節序號和殘余數據初始化
            idxByte = 0
            iLeft = 0
        End If

        '修改源串的指針和計數值
        idxSrc = idxSrc + 1

    Wend

    For idxSrc = 0 To idxDst - 1
        strOutput = strOutput & Chr(iDst(idxSrc))
    Next idxSrc

    Decode7BitASC = strOutput

End Function

'7-bit編碼
'strInput: 源字符串
'iArrayRtn: 目標編碼數組
Public Function Encode7BitASC(ByVal strInput As String) As String

    Dim idxSrc      As Long      '源字符串的計數值
    Dim idxDst      As Long      '目標編碼串的計數值
    Dim idxChar     As Long      '當前正在處理的組內字符字節的序號，范圍是0-7
    Dim iLeft       As Long      '上一字節殘余的數據
    Dim nSrcLength  As Long      '源字符串長度
    
    Dim iTmp        As Integer
    Dim iSrc()      As Integer
    Dim i           As Integer
    Dim iArrayRtn() As Integer

    On Error Resume Next
    idxSrc = 0
    idxDst = 0
    nSrcLength = Len(strInput)

    ReDim iSrc(0 To nSrcLength)
    ReDim iArrayRtn(0 To nSrcLength)

    For i = 1 To nSrcLength
        iSrc(i - 1) = AscB(Mid(strInput, i, 1))
    Next i

    '將源串每8個字節分為一組，壓縮成7個字節
    '循環該處理過程，直至源串被處理完
    '如果分組不到8字節，也能正確處理
    For idxSrc = 0 To nSrcLength

        '取源字符串的計數值的最低3位
        idxChar = idxSrc And 7

        '處理源串的每個字節
        If idxChar = 0 Then
        
            '組內第一個字節，只是保存起來，待處理下一個字節時使用
            iLeft = iSrc(idxSrc)
        Else

        '組內其它字節，將其右邊部分與殘余數據相加，得到一個目標編碼字節
            iTmp = BitLeftShift(iSrc(idxSrc), (8 - idxChar))
            DoEvents
            iTmp = BitAnd(iTmp, &HFF)
            iTmp = iTmp Or iLeft

            If iTmp <> 0 Then
                iArrayRtn(idxDst) = iTmp

                '修改目標串的指針和計數值 idxDst++;
                idxDst = idxDst + 1
            End If

            '將該字節剩下的左邊部分，作為殘余數據保存起來
            iLeft = BitRightShift(iSrc(idxSrc), idxChar)
        End If

    Next idxSrc

    Dim nTmp As Long
    Dim strTmp As String
    
    Encode7BitASC = ""
    For nTmp = 0 To idxDst
        strTmp = Hex(iArrayRtn(nTmp))
        If Len(strTmp) < 2 Then strTmp = "0" & strTmp
    Next nTmp
    
    Encode7BitASC = Trim(strTmp)

End Function

Public Function ASCII2Char(ByVal strAsc As String) As String

    Dim i       As Integer
    Dim j       As Integer
    
    Dim strTmp  As String
    Dim strTmpA As String
    Dim strTmpB As String

    On Error Resume Next
    j = Len(strAsc)
    strTmpB = ""

    For i = 1 To j
        strTmpA = Mid(strAsc, i, 1)
        If strTmpA <> " " Then strTmpB = strTmpB & strTmpA
    Next i

    j = Len(strTmpB)

    strTmp = ""
    For i = 1 To j Step 2
        strTmpA = Mid(strTmpB, i, 2)
        strTmp = strTmp & ChrB(Hex2Dec(strTmpA))
    Next i

    ASCII2Char = strTmp

End Function

Public Function CharToAscii(ByVal strChar As String) As String
    Dim iAsc As Integer
    
    Dim n1      As Long
    Dim n2      As Long
    
    Dim strTmp  As String
    Dim strTmp1 As String
    Dim strTmp2 As String
    
    On Error Resume Next
    n1 = LenB(strChar)
    strTmp = ""
    
    For n2 = 1 To n1
        iAsc = AscB(MidB(strChar, n2, 1))
        If iAsc <> 0 Then
            strTmp1 = Hex(iAsc)
            If Len(strTmp1) < 2 Then strTmp1 = "0" & strTmp1
            strTmp = strTmp & strTmp1 & " "
        End If
    Next n2
    
    CharToAscii = Trim(strTmp)

End Function

Public Function Hex2Dec(ByVal strInput As String) As Long
    Dim i       As Integer
    Dim j       As Integer
    Dim iLen    As Integer
    Dim iTmp    As Integer
    
    Dim nRet    As Long
    Dim strTmp  As String
    
    On Error Resume Next
    
    If strInput <> "" Then
        iLen = Len(strInput)
        nRet = 0
        For i = 1 To iLen
            iTmp = Asc(Mid(strInput, i, 1))
            If iTmp >= 48 And iTmp <= 57 Then               '"0" = 48, "9" = 57