Loop
    If n > 0 Then
        ReDim RetSMS(1 To n)
    Else
        ReDim RetSMS(0 To 0)
    End If
    '======== 逐條保存到數(shù)據(jù)庫(kù)中 ========
    For i = 1 To n
        iTmp = InStr(InputString, "+CMGL:")
        iCr = InStr(InputString, vbCr)
        If iCr > 0 And iTmp > 0 Then
            InputString = Right(InputString, Len(InputString) - iTmp + 1)
            iTmp = InStr(InputString, "+CMGL:")
            iNext = InStr(iTmp + 7, InputString, "+CMGL:")
            If iNext > 0 Then
                strTmp = Mid(InputString, iTmp, iNext - iTmp)
                InputString = Right(InputString, Len(InputString) - iNext + 1)
            Else
                iCr = InStr(iTmp, InputString, vbCr)
                iCr = InStr(iCr + 1, InputString, vbCr)
                strTmp = Mid(InputString, iTmp, iCr - iTmp)
                InputString = Right(InputString, Len(InputString) - iCr + 1)
            End If
            blRet = PickOneSMS(strTmp, RetSMS(i), True)
            If blRet Then
                On Error GoTo ErrorNode
ErrorNode:
            End If
        End If
    Next i
    PickAllSMS = "共有" & n & "條短信"
End Function
Public Function PickAllSMS1(ByRef InputString As String, RetSMS() As SMSDef) As String
    Dim i As Integer, iTmp As Integer, iLen As Integer, iNext As Integer, iCr As Integer
    Dim n As Long
    Dim strTmp As String, strTmp1 As String, strTmp2 As String
    Dim btTmp() As Byte, btTmp2() As Byte
    Dim blRet As Boolean
On Error Resume Next
    strTmp = ""
    btTmp = InputString
    '======== 將短消息中的雙引號(hào)去除 ========
    iTmp = 0
    For i = 0 To UBound(btTmp)
        strTmp1 = Chr(btTmp(i))
        If strTmp1 <> """" And btTmp(i) <> 0 And strTmp1 <> vbLf Then
            ReDim Preserve btTmp2(0 To iTmp + 1)
            btTmp2(iTmp) = btTmp(i)
            btTmp2(iTmp + 1) = 0
            iTmp = iTmp + 2
        End If
    Next i
    InputString = btTmp2
    n = 0
    i = 1
    Do
        iTmp = InStr(i, InputString, "+CMGR:")
        iCr = InStr(iTmp, InputString, vbCr)
        
        If iTmp > 0 Then
            If iCr - iTmp + 1 > 0 Then n = n + 1
        ElseIf iTmp = 0 Then
            Exit Do
        End If
        i = iTmp + 7
    Loop
    If n > 0 Then
        ReDim RetSMS(1 To n)
    Else
        ReDim RetSMS(0 To 0)
    End If
    '======== 逐條保存到數(shù)據(jù)庫(kù)中 ========
    For i = 1 To n
        iTmp = InStr(InputString, "+CMGR:")
        iCr = InStr(InputString, vbCr)
        If iCr > 0 And iTmp > 0 Then
            InputString = Right(InputString, Len(InputString) - iTmp + 1)
            iTmp = InStr(InputString, "+CMGR:")
            iNext = InStr(iTmp + 7, InputString, "+CMGR:")
            If iNext > 0 Then
                strTmp = Mid(InputString, iTmp, iNext - iTmp)
                InputString = Right(InputString, Len(InputString) - iNext + 1)
            Else
                iCr = InStr(iTmp, InputString, vbCr)
                iCr = InStr(iCr + 1, InputString, vbCr)
                strTmp = Mid(InputString, iTmp, iCr - iTmp)
                InputString = Right(InputString, Len(InputString) - iCr + 1)
            End If
            blRet = PickOneSMS(strTmp, RetSMS(i), False)
            If blRet Then
                On Error GoTo ErrorNode
ErrorNode:
            End If
        End If
    Next i
End Function
Public Function PickOneSMS(strInputData As String, RetSMS As SMSDef, ByVal blIsList As Boolean) As Boolean
    Dim blRetFunc       As Boolean
    Dim i As Integer, iLen As Integer, iCr As Integer
    Dim nD As Long, nRet As Long
    Dim strTmp As String, strTmp1 As String, strTmp2 As String, strTmp3 As String
    Dim MyStr()         As String
    Dim aryTmp()        As String
On Error GoTo ErrorSave
    '======== 取出短信息頭部 ========
    iCr = InStr(strInputData, vbCr)
    iLen = Len(strInputData)
    If iCr > 0 And iCr <= iLen Then
        strTmp2 = Left(strInputData, iCr - 1)
        strInputData = Right(strInputData, iLen - iCr)
    End If
    '======== 取出短信息內(nèi)容 ========
    iCr = InStr(strInputData, vbCr)
    iLen = Len(strInputData)
    If iCr > 0 Then
        If iCr <= iLen Then
            strTmp3 = Left(strInputData, iCr - 1)
            strInputData = Right(strInputData, iLen - iCr)
        End If
    Else
        If iCr < iLen Then
            strTmp3 = strInputData
        End If
    End If
On Error GoTo ErrorDecode
    '======== 分解短消息，以逗號(hào)(,)作為分隔符 ========
    Dim myFunc As New myVBDll
    blRetFunc = False
    blRetFunc = myFunc.String2Array(strTmp2, ",", nD, aryTmp, True)
ErrorDecode:
    Set myFunc = Nothing
    If blRetFunc Then
    '======== 如果傳過(guò)來(lái)的短消息格式是"CMGL" ========
        If blIsList Then
            ReDim MyStr(0 To nD - 1)
            For i = 0 To nD - 2
                MyStr(i) = aryTmp(i + 1)
            Next i
    '======== 否則，傳送過(guò)來(lái)的消息格式是"CMGR"，這兩者是有區(qū)別的。 ========
        Else
            ReDim MyStr(0 To nD - 1)
            For i = 0 To nD - 1
                MyStr(i) = aryTmp(i)
            Next i
        End If
        iLen = InStr(aryTmp(0), ":")
        If iLen > 0 Then
            strTmp = Trim(Right(aryTmp(0), Len(aryTmp(0)) - iLen))
            If IsNumeric(strTmp) Then
                RetSMS.SmsIndex = CLng(strTmp)
            End If
        End If
        RetSMS.ListOrRead = blIsList
        '======== 如果對(duì)方的SIM號(hào)碼前面有"+86"，則剔除掉 ========
        On Error Resume Next
        If Left(MyStr(1), 3) = "+86" Then
            MyStr(1) = Right(MyStr(1), Len(MyStr(1)) - 3)
        End If
        '======== 如果時(shí)間中含有時(shí)區(qū)，則去除 ========
        iLen = InStr(MyStr(3), "+")
        If iLen > 0 Then MyStr(3) = Left(MyStr(3), iLen - 1)
        iLen = InStr(MyStr(3), "-")
        If iLen > 0 Then MyStr(3) = Left(MyStr(3), iLen - 1)
        '======== 取出短信中的用戶數(shù)據(jù)UD ========
        iCr = InStr(strTmp3, vbCr)
        If iCr > 0 Then
            strTmp3 = Left(strTmp3, iCr - 1)
        End If
        '======== 分別提取短消息的詳細(xì)內(nèi)容 ========
        RetSMS.SmsMain = DecodeUnicode(strTmp3)
        RetSMS.SourceNo = MyStr(1)
        RetSMS.ReachDate = MyStr(2)
        RetSMS.ReachTime = MyStr(3)
        If Err = 0 Then PickOneSMS = True
    End If
    Exit Function
ErrorSave:
    PickOneSMS = False
End Function
Public Function DecodeUnicode(ByVal UnicodeString As String) As String
    Dim strUnicode As String
    Dim objDll As New myVBDll
On Error GoTo ErrorUnicode
    strUnicode = UnicodeString
    DecodeUnicode = objDll.Unicode2GB(strUnicode)
    Set objDll = Nothing
    Exit Function
ErrorUnicode:
    Set objDll = Nothing
    MsgBox "Error:" & Err & "." & vbCrLf & Err.Description
End Function
Public Function AddTask(ByRef TaskWord As Long, TaskTable() As String, ByVal WorkTask As Long, ByVal TaskID As Long, ByVal WillDo As String) As Boolean
    On Error GoTo ErrorAdd
    TaskWord = TaskWord Or WorkTask
    TaskTable(TaskID) = WillDo
    AddTask = True
    Exit Function
ErrorAdd:
    AddTask = False
End Function