telcmd.bas

VB编写的手机短信源码

Attribute VB_Name = "TelCmd"
Option Explicit

'*/-------------------------------------------------------------
'*/函 数 名:initializtionDevice
'*/功    能:初始化硬件设备
'*/返 回 值:布尔
'*/-------------------------------------------------------------
Public Function inDevice() As Boolean
  If InStr(SendAT("AT&F", 5), "OK") > 0 Then
    Pause 0.2
    If InStr(SendAT("ATE1", 5), "OK") > 0 Then
      Pause 0.2
      If InStr(SendAT("ATV1", 5), "OK") > 0 Then
        Pause 0.2
        If InStr(SendAT("ATQ0", 5), "OK") > 0 Then
          Pause 0.2
          If InStr(SendAT("ATX4", 5), "OK") > 0 Then
            Pause 0.2
            If InStr(SendAT("AT+CMEE=0", 5), "OK") > 0 Then   '0,不显示详细错误信息  1,显示
              Pause 0.2
              If InStr(SendAT("AT+CMER=1", 5), "OK") > 0 Then
                Pause 0.2
                If InStr(SendAT("AT+CLIP=1", 5), "OK") > 0 Then
                  Pause 0.2
                  If InStr(SendAT("AT+CMGF=0", 5), "OK") > 0 Then
                    Pause 0.2
                    Call sGetCNMI
                    Pause 0.2
                    Call sGetCSCS
                    Pause 0.2
                    inDevice = True
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:sGetCNMI
'*/功    能:获取设备数据接收顺序并针对设置
'*/返 回 值:布尔
'*/-------------------------------------------------------------
Function sGetCNMI() As Boolean
    Dim strCOM32 As String
    sGetCNMI = False
    strCOM32 = SendAT("AT+CNMI=?", 5)
    If InStr(strCOM32, "OK") > 0 Then
       If GetCGMI = "SIEMENS" Then    '针对西门子初始化
          If InStr(SendAT("AT+CNMI=1,1,0,2,1", 5), "OK") > 0 Then sGetCNMI = True
       Else   '针对WAVECOM初始化
          If InStr(SendAT("AT+CNMI=2,3,0,1,0", 5), "OK") > 0 Then sGetCNMI = True
       End If
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCGMI
'*/功    能:获取设备厂家标识
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCGMI() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CGMI", 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCGMI = Left(strCOM32, InStr(strCOM32, vbCr) - 1)
    Else
       GetCGMI = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCGMM
'*/功    能:获取设备型号
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCGMM() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CGMM", 8)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCGMM = Left(strCOM32, InStr(strCOM32, vbCr) - 1)
    Else
       GetCGMM = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCGMR
'*/功    能:获取设备软件版本
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCGMR() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CGMR", 8)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCGMR = Left(strCOM32, InStr(strCOM32, vbCr) - 1)
    Else
       GetCGMR = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCGSMimei
'*/功    能:获取设备移动台标识号(IMEI)电子串号
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCGSNimei() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CGSN", 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCGSNimei = Left(strCOM32, InStr(strCOM32, vbCr) - 1)
    Else
       GetCGSNimei = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCIMIimsi
'*/功    能:获取SIM卡标识号(IMSI)
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCIMIimsi() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CIMI", 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCIMIimsi = Left(strCOM32, InStr(strCOM32, vbCr) - 1)
    Else
       GetCIMIimsi = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCOPS
'*/功    能:获取当前网络
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCOPS() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+COPS?", 5)
    If InStr(strCOM32, "OK") > 0 Then
       If Val(Right(Left(Mid(strCOM32, InStr(strCOM32, vbLf) + 1), 19), 8)) = 0 Then '  "      "
          strCOM32 = SendAT("AT+COPS=3,2", 5)
          If InStr(strCOM32, "OK") > 0 Then
             strCOM32 = SendAT("AT+COPS?", 5)
             strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
             GetCOPS = Mid(Right(Left(strCOM32, InStr(strCOM32, vbLf) - 2), 7), 2, 5)
          End If
       Else
          strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
          GetCOPS = Mid(Right(Left(strCOM32, InStr(strCOM32, vbLf) - 2), 7), 3, 5)
       End If
    Else
       GetCOPS = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCSCA
'*/功    能:获取短信中心号码
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCSCA() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CSCS=" & Chr(34) & "GSM" & Chr(34), 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = SendAT("AT+CSCA?", 5)
       If InStr(strCOM32, "OK") > 0 Then
          strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
          GetCSCA = Mid(strCOM32, InStr(strCOM32, ":") + 3, 14)
       End If
    Else
       GetCSCA = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCBC
'*/功    能:获取设备电池
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCBC() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CBC", 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCBC = Mid(Left(strCOM32, InStr(strCOM32, vbCr) - 1), 7, 6)
    Else
       GetCBC = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCSQ
'*/功    能:获取信号强度
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCSQ() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CSQ", 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       GetCSQ = Mid(Left(strCOM32, InStr(strCOM32, vbCr) - 1), 7, 6)
    Else
       GetCSQ = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCNUM
'*/功    能:获取本机号码
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCNUM() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CNUM", 5)
    
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
       If Left(strCOM32, 2) = "OK" Then
          GetCNUM = ""
       Else
          GetCNUM = Mid(strCOM32, InStr(strCOM32, ",") + 2, 11)
       End If
    Else
       GetCNUM = ""
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetCCLK
'*/功    能:获取设备时钟
'*/返 回 值:字符
'*/-------------------------------------------------------------
Function GetCCLK() As String
    Dim strCOM32 As String
    strCOM32 = SendAT("AT+CCLK?", 5)
    If InStr(strCOM32, "+CME ERROR:") = 0 Then
        If InStr(strCOM32, "+CCLK:") > 0 Then
           strCOM32 = Mid(strCOM32, InStr(strCOM32, vbLf) + 1)
           GetCCLK = Mid(strCOM32, InStr(strCOM32, Chr(34)), InStr(strCOM32, vbLf) - (InStr(strCOM32, Chr(34)) + 1))
        Else
           GetCCLK = ""
        End If
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:sGetCSCS
'*/功    能:获取设备字符编码
'*/返 回 值:布尔
'*/-------------------------------------------------------------
Function sGetCSCS() As Boolean
    Dim strCOM32 As String
    sGetCSCS = False
    strCOM32 = SendAT("AT+CSCS=?", 5)
    If InStr(strCOM32, "OK") > 0 Then
       If InStr(strCOM32, "UCS2") > 0 Then
          strCOM32 = SendAT("AT+CSCS=" & Chr(34) & "UCS2" & Chr(34), 5)
       End If
       If InStr(strCOM32, "HEX") > 0 Then
          strCOM32 = SendAT("AT+CSCS=" & Chr(34) & "HEX" & Chr(34), 5)
       End If
       If InStr(strCOM32, "OK") > 0 Then sGetCSCS = True
    End If
End Function

'*/-------------------------------------------------------------
'*/功    能:一些读取电话簿的AT指令的操作
'*/函数列表:GetPBinfo,GetAddresslist,GetPBs,GetTelNameinPB
'*/-------------------------------------------------------------

'*/-------------------------------------------------------------
'*/函 数 名:GetPBinfo
'*/功    能:获取电话簿存储信息
'*/返 回 值:字符 已存数/存储容量
'*/参    数:StoreType  存储类型("SM"为SIM卡，"MT"为设备)
'*/-------------------------------------------------------------

Public Function GetPBinfo(StoreType As String) As String
    Dim strCOM32 As String, sActual As String, sTotal As String
    
    strCOM32 = SendAT("AT+CPBS=" & Chr(34) & StoreType & Chr(34), 5)
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = SendAT("AT+CPBS?", 5)
       If InStr(strCOM32, "OK") > 0 Then
          sActual = Right(strCOM32, Len(strCOM32) - inString(",", strCOM32))
          sActual = Left(sActual, inString(",", sActual) - 1)
          sTotal = Right(strCOM32, Len(strCOM32) - inString(",", strCOM32, 1))
          sTotal = Left(sTotal, inString(vbCr, sTotal) - 1)
          GetPBinfo = sActual & "/" & sTotal
       End If
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetAddresslist
'*/功    能:获取通讯录存储信息 (设备)
'*/返 回 值:字符 已存数/存储容量
'*/-------------------------------------------------------------
Public Function GetAddresslist() As String
    Dim strCOM32 As String, sActual As String, sTotal As String
    
    strCOM32 = SendAT("AT^SDBR=?", 5)
    If InStr(strCOM32, "OK") > 0 Then
          sActual = Right(strCOM32, Len(strCOM32) - InStr(strCOM32, Chr(32))): sActual = Left(sActual, InStr(sActual, vbLf) - 2)
          sActual = Left(Mid(sActual, InStr(sActual, "-") + 1, InStr(sActual, ")") - 1), InStr(Mid(sActual, InStr(sActual, "-") + 1, InStr(sActual, ")") - 1), ")") - 1)
          
          strCOM32 = SendAT("AT^SBNR=?", 5)
          If InStr(strCOM32, "OK") > 0 Then
            sTotal = Right(strCOM32, Len(strCOM32) - InStr(strCOM32, Chr(32))): sTotal = Right(sTotal, Len(sTotal) - InStr(sTotal, "vcf") - 5)
            sTotal = Left(Mid(sTotal, InStr(sTotal, "-") + 1, InStr(sTotal, ")") - 1), InStr(Mid(sTotal, InStr(sTotal, "-") + 1, InStr(sTotal, ")") - 1), ")") - 1)
          End If
    End If
    If sActual = "" And sTotal = "" Then
        GetAddresslist = "N/A"
    Else
        GetAddresslist = sActual & "/" & sTotal
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetPBs
'*/功    能:获取电话簿存储信息信息
'*/返 回 值:字符
'*/参    数:dhex
'*/-------------------------------------------------------------
Function GetPBs() As Boolean
    Dim sTemp As Variant
    sTemp = SendAT("AT+CPBS=?", 5)
    If inString("+CPBS:", sTemp) <> 0 Then
        sTemp = Right(sTemp, Len(sTemp) - inString("(", sTemp) - 1)
        sTemp = Left(sTemp, inString(")", sTemp) - 2)
        sTemp = Split(sTemp, Chr(34) & "," & Chr(34))
        'For i = 1 To UBound(sTemp): Combo1.AddItem sTemp(i): Next
        GetPBs = True
    Else
        GetPBs = False
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetTelNameinPB
'*/功    能:获取指定存储位置的电话号码和名称
'*/返 回 值:字符
'*/参    数:Pbint   指定存储记录指针
'*/-------------------------------------------------------------
Function GetTelNameinPB(Pbint As Integer) As String
    Dim strCOM32 As String, sTelCode As String, sName As String
    'On Error Resume Next
    strCOM32 = SendAT("AT+CPBR=" & Pbint, 5)
    
    If inString("+CPBR:", strCOM32) <> 0 Then
       sTelCode = Right(strCOM32, Len(strCOM32) - inString(Chr(34), strCOM32))
       sTelCode = Left(sTelCode, inString(Chr(34), sTelCode) - 1)
       sName = Right(strCOM32, Len(strCOM32) - inString(Chr(34), strCOM32, 2))
       sName = Left(sName, inString(Chr(34), sName) - 1)
       
       GetTelNameinPB = sTelCode & Space(2)   ' & IIf(InStr(sName, "FFFF") > 0, UCS2GBChr(Mid(sName, 3, Len(sName) - 6), 4), UCS2GBChr(sName, 4))
       If InStr(sName, "FFFF") > 0 Then
          GetTelNameinPB = GetTelNameinPB & UCS2GBChr(Mid(sName, 3, Len(sName) - 6), 4)
       Else
          GetTelNameinPB = GetTelNameinPB & UCS2GBChr(sName, 4)
       End If
    End If
End Function

'*/-------------------------------------------------------------
'*/函 数 名:GetShortinfo
'*/功    能:获取指定存储器存储的信息
'*/返 回 值:字符 已存数/存储容量
'*/参    数:StoreType  存储类型
'*/-------------------------------------------------------------
Public Function GetShortinfo(StoreType As String) As String
    Dim strCOM32 As String, sActual As String, sTotal As String
    
    strCOM32 = SendAT("AT+CPMS=" & Chr(34) & StoreType & Chr(34), 10)
    Pause 1
    If InStr(strCOM32, "OK") > 0 Then
       strCOM32 = Right(strCOM32, Len(strCOM32) - InStr(strCOM32, Chr(32)))
       sActual = Split(strCOM32, ",")(1)
       sTotal = Split(strCOM32, ",")(2)
       GetShortinfo = sActual & "/" & sTotal
    Else
       GetShortinfo = "N/A"
    End If
End Function