myvbdll.cls

这是一个通过手机串口实现短信发送的实例

                nRet = nRet + (iTmp - 48) * 16 ^ (iLen - i)
            ElseIf iTmp >= 65 And iTmp <= 70 Then           '"A" = 65, "F" = 70
                nRet = nRet + (iTmp - 55) * 16 ^ (iLen - i)
            ElseIf iTmp >= 97 And iTmp <= 102 Then          '"a" = 97, "f" = 102
                nRet = nRet + (iTmp - 87) * 16 ^ (iLen - i)
            Else
                nRet = 0
                Exit For
            End If
        Next i
    End If
    
    Hex2Dec = nRet

End Function

Public Function GB2Unicode(ByVal strGB As String) As String

    Dim byteA()         As Byte
    
    Dim i               As Integer
    
    Dim strTmpUnicode   As String
    Dim strA            As String
    Dim strB            As String

    On Error GoTo ErrorUnicode
    
    i = LenB(strGB)
    
    ReDim byteA(1 To i)
    
    For i = 1 To LenB(strGB)
        strA = MidB(strGB, i, 1)
        byteA(i) = AscB(strA)
    Next i
    
    '此时已经将strGB转换为Unicode编码，保存在数组byteA()中。
    '下面需要调整顺序并以字符串的形式返回
    strTmpUnicode = ""
    
    For i = 1 To UBound(byteA) Step 2
        strA = Hex(byteA(i))
        If Len(strA) < 2 Then strA = "0" & strA
        strB = Hex(byteA(i + 1))
        If Len(strB) < 2 Then strB = "0" & strB
        strTmpUnicode = strTmpUnicode & strB & strA
    Next i
    
    GB2Unicode = strTmpUnicode
    Exit Function

ErrorUnicode:
    MsgBox "错误：" & Err & "." & vbCrLf & Err.Description
    GB2Unicode = ""
End Function

Public Function Unicode2GB(ByVal strUnicode As String) As String

    Dim byteA()     As Byte
    
    Dim i           As Integer
    
    Dim strTmp      As String
    Dim strTmpGB    As String
    
    
    On Error GoTo ErrUnicode2GB
    
    i = Len(strUnicode) / 2
    ReDim byteA(1 To i)
    
    For i = 1 To Len(strUnicode) / 2 Step 2
        strTmp = Mid(strUnicode, i * 2 - 1, 2)
        strTmp = Hex2Dec(strTmp)
        byteA(i + 1) = strTmp
        strTmp = Mid(strUnicode, i * 2 + 1, 2)
        strTmp = Hex2Dec(strTmp)
        byteA(i) = strTmp
    Next i
    
    strTmpGB = ""
    For i = 1 To UBound(byteA)
        strTmp = byteA(i)
        strTmpGB = strTmpGB & ChrB(strTmp)
    Next i
    
    Unicode2GB = strTmpGB
    Exit Function

ErrUnicode2GB:
    MsgBox "Err=" & Err.Number & ",原因：" & Err.Description
    Unicode2GB = ""
End Function

'此函数是将一个字符串中以charRef为分隔符的元素保存到数组MyStr()中
'*********************************************
'参数：
'============================================
'|YourStr：  |  待分隔的字符串
'+-----------+-------------------------------
'|charRef：  |  分隔符号
'+-----------+-------------------------------
'|isNormal： |  如果为假，则表示分隔符可能由
'|           |  多个空格组成，例如Tab符号。
'+-----------+-------------------------------
'|nD：       |  返回值，表示有多少个元素
'+-----------+-------------------------------
'|MyStr()：  |  返回值，保存分隔后的各个元素。
'============================================
'
'**********************************************
Public Function String2Array(ByVal YourStr As String, _
                             ByVal charRef As String, _
                             ByRef nD As Long, _
                             ByRef MyStr() As String, _
                             ByVal isNormal As Boolean) As Boolean

    Dim i           As Long
    Dim j           As Long
    Dim nUBound     As Long
    
    Dim iAsc        As Integer
    
    Dim strChar     As String
    Dim strTmp      As String
    Dim aryTr()     As String
  
    On Error GoTo ErrorDecode

    strChar = ""
    YourStr = Trim(YourStr)     '首先去掉字符串两边的空格
    nUBound = 1
    j = 0
    ReDim aryTr(1 To nUBound)

    If Not isNormal Then
        For i = 1 To Len(YourStr)
            strTmp = Mid(YourStr, i, 1)
            iAsc = Asc(strTmp)
            If iAsc > 122 Or iAsc < 33 Then
                strChar = Mid(YourStr, i - j, j)
                If strChar <> "" Then
                    aryTr(nUBound) = strChar
                    nUBound = nUBound + 1
                    ReDim Preserve aryTr(1 To nUBound)
                End If
                strChar = ""
                j = 0
            Else
                j = j + 1
                If i = Len(YourStr) Then
                    strChar = Mid(YourStr, i - j + 1, j)
                    aryTr(nUBound) = strChar
                End If
            End If
        Next i
        nD = nUBound
        ReDim MyStr(0 To nUBound - 1)
        For i = 1 To nUBound
            MyStr(i - 1) = aryTr(i)
        Next i
        String2Array = True
    Else
        For i = 1 To Len(YourStr)
            strTmp = Mid(YourStr, i, 1)
            If strTmp = charRef Then
                strChar = Mid(YourStr, i - j, j)
                If strChar <> "" Then
                    aryTr(nUBound) = strChar
                    nUBound = nUBound + 1
                    ReDim Preserve aryTr(1 To nUBound)
                End If
                strChar = ""
                j = 0
            Else
                j = j + 1
                If i = Len(YourStr) Then
                    strChar = Mid(YourStr, i - j + 1, j)
                    aryTr(nUBound) = strChar
                End If
            End If
        Next i
        nD = nUBound
        ReDim MyStr(0 To nUBound - 1)
        For i = 1 To nUBound
            MyStr(i - 1) = aryTr(i)
        Next i
        String2Array = True
    End If

    Exit Function

ErrorDecode:
    MsgBox Err.Number & ":" & Err.Description
    String2Array = False
End Function


Public Sub QuickSort(InputArray() As Double, LowPos As Integer, HighPos As Integer)
    Dim iPivot As Integer

    If LowPos < HighPos Then
        iPivot = PartitionA(InputArray, LowPos, HighPos)
        Call QuickSort(InputArray, LowPos, iPivot - 1)
        Call QuickSort(InputArray, iPivot + 1, HighPos)
    End If

End Sub

Private Sub Swap(InputArray() As Double, FirstPos As Integer, SecondPos As Integer)
    Dim dblTmp As Double
    
    dblTmp = InputArray(FirstPos)
    InputArray(FirstPos) = InputArray(SecondPos)
    InputArray(FirstPos) = dblTmp
End Sub

Private Function PartitionA(R() As Double, ByVal iB As Integer, ByVal iE As Integer) As Integer
    '//并返回基准记录的位置
    Dim dblPivot As Double
    
    '===== 用区间的第1个记录作为基准 =====
    dblPivot = R(iB)
    '===== { 从区间两端交替向中间扫描，直至iB=iE为止 =====
    Do While (iB < iE)
        '----- pivot相当于在位置iB上 -----
        Do While (iB < iE And R(iE) >= dblPivot)
            '--- 从右向左扫描，查找第1个小于Pivot的记录R(iE) ---
            iE = iE - 1
        Loop
        '----- 表示找到的R(iE) < dblPivot -----
        If (iB < iE) Then
            '--- 相当于交换R(ib)和R(ie)，交换后iB指针加1 ---
            R(iB) = R(iE)
            iB = iB + 1
        End If
        '----- Pivot相当于在位置iE上 -----
        Do While (iB < iE And R(iB) <= dblPivot)
            '--- 从左向右扫描，查找第1个大于Pivot的记录R(iB) ---
            iB = iB + 1
        Loop
        '----- 表示找到了R(iB)，使R(iB) > Pivot -----
        If (iB < iE) Then
            '--- 相当于交换R(iB)和R(iE)，交换后iE指针减1 ---
            R(iE) = R(iB)
            iE = iE - 1
        End If
    Loop
    '===== 基准记录已被最后定位 =====
    R(iB) = dblPivot
    PartitionA = iB
End Function

Private Function Partition(InputArray() As Double, LowPos As Integer, HighPos As Integer) As Integer
    Dim dblPivot As Double
    Dim iPos As Integer, iTmp As Integer
    Dim i As Integer, j As Integer

    iPos = LowPos
    dblPivot = InputArray(iPos)
    For i = LowPos + 1 To HighPos
        If InputArray(i) < dblPivot Then
            Call Swap(InputArray, iPos, i)
            iPos = iPos + 1
        End If
    Next i
    Call Swap(InputArray, LowPos, iPos)
    Partition = iPos
End Function