Attribute VB_Name = "modMain"
'這個函數(shù)主要應(yīng)用到VB自帶的一個格式轉(zhuǎn)換函數(shù)：ChrW（）將中文轉(zhuǎn)換為Unicode碼。
Dim start As Date

Public mOK As String
Public mErr As String
Public mResult As String, txtOut As String, sData As String
Dim doit As Boolean, MsgArrive As Boolean

Public Sub setDoit(mdoit As Boolean)
   doit = mdoit
End Sub

'手機(jī)短信的接收,將UNICODE轉(zhuǎn)換中文
Public Function Unicode2AscII(ByVal s As String)
    On Error Resume Next
    Dim i As Integer
    Dim R As String
    For i = 1 To Len(s) Step 4
        R = R + ChrB("&H" & Mid(s, i + 2, 2)) & ChrB("&H" & Mid(s, i, 2))
    Next
    Unicode2AscII = R
End Function

'同上,為了發(fā)送以PDU模式發(fā)送短消息,必須將手機(jī)號碼和對方手機(jī)號碼也轉(zhuǎn)換為PDU格式,下面的函數(shù)就是為了實現(xiàn)這種轉(zhuǎn)換：
Public Function telc(num As String) As String
    Dim tl As Integer
    Dim ltem As String, rtem As String, ttem As String
    Dim ti As Integer
    ttem = ""
    tl = Len(num)
    If tl <> 11 And tl <> 13 Then
        MsgBox "號碼錯誤:" & tl
        Exit Function
    End If
    If tl = 11 Then
        tl = tl + 2
        num = "86" & num
    End If
    For ti = 1 To tl Step 2
        ltem = Mid(num, ti, 1)
        rtem = Mid(num, ti + 1, 1)
        If ti = tl Then rtem = "F"
        ttem = ttem & rtem & ltem
    Next ti
    telc = ttem
End Function
' 將一個字符串兩兩轉(zhuǎn)換
Public Function ExChange(ByVal num As String) As String
    Dim tl, ti As Integer
    Dim ltem As String, rtem As String, ttem As String
    tl = Len(num)
    For ti = 1 To tl - 1 Step 2
        ltem = Mid(num, ti, 1)
        rtem = Mid(num, ti + 1, 1)
        ExChange = ExChange & rtem & ltem
    Next ti
End Function

'Unicode碼解碼函數(shù)
Public Function Ascg(sMsg As String) As String
    Dim si As Integer, sb As Integer
    Dim stmp As Integer
    Dim stemp As String
    sb = Len(sMsg)
    Ascg = ""
    For si = 1 To sb
    stmp = AscW(Mid(sMsg, si, 1))
    If Abs(stmp) < 127 Then
    stemp = "00" & Hex(stmp)
    Else
     stemp = Hex(stmp)
     End If
     Ascg = Ascg & stemp
    Next si
    Ascg = Trim(Ascg)
End Function

Public Sub Delay(pause As Double)
    start = Timer
    While Timer < start + pause
        DoEvents
    Wend
End Sub

Public Function getScsa(ByVal s As String)
    s1 = ""
    If Len(s) > 0 Then
        p = InStr(s, Chr(34))
        s1 = Mid(s, p + 1)
        p1 = InStr(s1, Chr(34))
        If p > 0 Then
            s1 = Mid(s1, 1, p1 - 1)
        End If
    End If
    getScsa = s1
End Function

Public Function sendIt(ByVal s As String, ByVal ok As String, ByVal eror As String, Optional ByVal TOut = 2) As Boolean
    mOK = ok
    mErr = eror
    'LstState.AddItem "正在發(fā)送..." & s
    If SeverFrm.MSComm1.PortOpen = False Then
        sendIt = False
        Exit Function
    End If
    SeverFrm.MSComm1.Output = s & Chr(13)
    Dim p As Double, p1 As Double, p2 As Double
    p = 0.0001 * TOut
    p2 = 0#
    doit = False
    sData = ""
    Dim dt1 As Date, dt2 As Date
    dt1 = Now
    s1 = ""
    While doit = False
        dt2 = Now
        p1 = (dt2 - dt1)
        'p2 = p1 * 10000#
        If p1 >= p Then
            doit = True
            sendIt = False
            Exit Function
        End If
        DoEvents
    Wend
    sendIt = True
End Function

Public Sub setStatus(ByVal s As String)
    SeverFrm.StatusMsg.Panels(3).Text = "" & s
End Sub