VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "PC機(jī)與GSM串口通信程序"
   ClientHeight    =   2670
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8730
   FillColor       =   &H00808080&
   Icon            =   "PC&GSM.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2670
   ScaleWidth      =   8730
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdRead 
      Caption         =   "讀取短信"
      Height          =   390
      Left            =   420
      TabIndex        =   14
      Top             =   2100
      Width           =   1185
   End
   Begin VB.CommandButton TestAT 
      Caption         =   "測(cè)試AT"
      Height          =   390
      Left            =   2625
      TabIndex        =   13
      Top             =   2100
      Width           =   1185
   End
   Begin VB.CommandButton Cmdquit 
      Caption         =   "退  出"
      Height          =   390
      Left            =   4725
      TabIndex        =   12
      Top             =   2100
      Width           =   1185
   End
   Begin VB.Frame Frame1 
      Caption         =   "返回信息"
      Height          =   1695
      Left            =   6090
      TabIndex        =   8
      Top             =   105
      Width           =   2535
      Begin VB.TextBox txtReceived 
         BackColor       =   &H00FFFFFF&
         ForeColor       =   &H00008000&
         Height          =   1275
         HideSelection   =   0   'False
         Left            =   105
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   9
         ToolTipText     =   "終端返回的信息內(nèi)容"
         Top             =   315
         Width           =   2310
      End
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   7140
      Top             =   2100
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   80
      Left            =   6510
      Top             =   2100
   End
   Begin VB.Frame Frame 
      Caption         =   "短信接收區(qū)"
      Height          =   1755
      Index           =   31
      Left            =   105
      TabIndex        =   1
      Top             =   105
      Width           =   5880
      Begin VB.TextBox ReadNO 
         Height          =   285
         Left            =   5250
         TabIndex        =   10
         Text            =   "1"
         Top             =   525
         Width           =   420
      End
      Begin VB.TextBox SMSNo 
         Height          =   360
         Left            =   1155
         TabIndex        =   4
         Top             =   1260
         Width           =   1335
      End
      Begin VB.TextBox SMSTime 
         Height          =   375
         Left            =   3675
         TabIndex        =   3
         Top             =   1245
         Width           =   2070
      End
      Begin VB.TextBox SMSText 
         Height          =   705
         Left            =   1155
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Top             =   345
         Width           =   2790
      End
      Begin VB.Label Label 
         Caption         =   "短信位置："
         Height          =   255
         Index           =   76
         Left            =   4200
         TabIndex        =   11
         Top             =   555
         Width           =   990
      End
      Begin VB.Label Label 
         Caption         =   "短信號(hào)碼："
         Height          =   285
         Index           =   72
         Left            =   210
         TabIndex        =   7
         Top             =   1365
         Width           =   960
      End
      Begin VB.Label Label 
         Caption         =   "接收時(shí)間："
         Height          =   285
         Index           =   79
         Left            =   2730
         TabIndex        =   6
         Top             =   1365
         Width           =   1065
      End
      Begin VB.Label Label 
         Caption         =   "短信內(nèi)容："
         Height          =   285
         Index           =   73
         Left            =   210
         TabIndex        =   5
         Top             =   630
         Width           =   960
      End
   End
   Begin VB.CommandButton Command8 
      Caption         =   "Command4"
      Height          =   375
      Left            =   22320
      TabIndex        =   0
      Top             =   0
      Width           =   1695
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   7875
      Top             =   1995
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      RThreshold      =   1
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定義模塊級(jí)變量
Dim ary_strTask(0 To 31) As String
Dim n_TaskWord As Long
'初始化
Private Sub Form_Load()
   MSComm1.CommPort = 1
   MSComm1.Settings = "9600,n,8,1"
   MSComm1.InputLen = 0
   MSComm1.RThreshold = 1
   MSComm1.SThreshold = 0
   MSComm1.PortOpen = True
   CmdRead.Enabled = False
End Sub
'測(cè)試GSM
Private Sub TestAT_Click()
   txtReceived.Text = ""
   MSComm1.Output = "AT" & vbCr
   MSComm1.Output = "AT+CMGF=0" & vbCr                    '設(shè)置短信發(fā)送方式:PDU
   Sleep (1000)
   MSComm1.Output = "AT+CNMI=" & "3,1,2,0" & vbCr
   Sleep (1000)
   MSComm1.Output = "AT+CPMS=" & "SM,ME,SM" & vbCr
   CmdRead.Enabled = True
End Sub
'讀取短消息
Private Sub CmdRead_Click()
    If MSComm1.PortOpen = True Then
        txtReceived.Text = ""
        Call AddTask(n_TaskWord, ary_strTask, 16, 11, "AT+CMGF=1" & vbCr)
        Call AddTask(n_TaskWord, ary_strTask, 8, 12, "AT+CMGR=" & ReadNO.Text & vbCr)
    End If
    If Timer1.Enabled = False Then Timer1.Enabled = True
    If Timer2.Enabled = False Then Timer2.Enabled = True
End Sub
Private Sub MSComm1_OnComm()
    Dim blTmp As Boolean
    Dim strATData As String
    Dim strGetInfo As String
    Dim tmpBuf() As Byte, strTmp As String, strTmpHex As String, i As Integer
    On Error Resume Next
    Select Case MSComm1.CommEvent
        Case comEvReceive
          If g_blIsHexCommData Then
            tmpBuf = MSComm1.Input
            For i = 0 To UBound(tmpBuf)
               strTmpHex = Hex(tmpBuf(i))
               If Len(strTmpHex) < 2 Then strTmpHex = "0" & strTmpHex
            Next i
          Else
            strTmp = MSComm1.Input
            txtReceived.Text = txtReceived.Text & strTmp
            blTmp = GetDataFromCommPort(strTmp, strATData, strGetInfo)
            Me.Caption = strGetInfo
          End If
        Case Else
           MsgBox MSComm1.CommEvent
    End Select
End Sub
Private Sub Timer2_Timer()
  Timer2.Enabled = False
  Call cmdAnalosys
End Sub
Private Sub cmdAnalosys()
    Dim nU As Long, n As Long
    Dim lenpc As Long
    Dim strReceived As String
    Dim obj_ArySMSList() As SMSDef
On Error Resume Next
    strReceived = txtReceived.Text
    lenpc = InStr(strReceived, "+CMGR:")
    If lenpc > 0 Then
      Me.Caption = PickAllSMS1(strReceived, obj_ArySMSList)
    Else
      Me.Caption = PickAllSMS(strReceived, obj_ArySMSList)
    End If
On Error Resume Next
    nU = UBound(obj_ArySMSList)
    If nU > 0 Then
       For n = 1 To nU
          If lenpc > 0 Then
             SMSNo.Text = obj_ArySMSList(n).SourceNo
             SMSTime.Text = Format(obj_ArySMSList(n).ReachDate, "YYYY-MM-DD") & " " & Format(obj_ArySMSList(n).ReachTime, "HH:MM:SS") & vbCrLf
             SMSText.Text = obj_ArySMSList(n).SmsMain
          End If
       Next n
    End If
End Sub
Private Sub Timer1_Timer()
    Timer1.Enabled = ScanTaskA
End Sub
Private Function ScanTaskA() As Boolean
    Dim nTmp As Long
    Dim i_ScanPtr As Integer
    Dim ary_nCommandFlag(0 To 31) As Long
    For i = 0 To 15
       ary_nCommandFlag(i) = 2 ^ (15 - i)
    Next i
On Error Resume Next
ContinueScan:
    '======= 取出命令標(biāo)志數(shù)組 =======
    nTmp = ary_nCommandFlag(i_ScanPtr)
    '======= 察看標(biāo)志是否等于1 =======
    If (n_TaskWord And nTmp) <> 0 Then
        '------- 如果有任務(wù)存在，則準(zhǔn)備執(zhí)行之,任務(wù)執(zhí)行的條件是串口打開(kāi)，而且沒(méi)有正在進(jìn)行的接收任務(wù) -------
        If MSComm1.PortOpen = True Then
            '------- 將任務(wù)命令下發(fā) -------
            MSComm1.Output = ary_strTask(i_ScanPtr)
        Else
            '------- 如果執(zhí)行的條件不滿足，則保留權(quán)利，等待下次會(huì)話 -------
            ScanTaskA = True
            Exit Function
        End If
       ' 如果程序能夠執(zhí)行到此處，說(shuō)明該任務(wù)已經(jīng)完成那么將該任務(wù)的標(biāo)志刪除
        n_TaskWord = (n_TaskWord And (Not nTmp))
        '因?yàn)橐粋€(gè)會(huì)話只能執(zhí)行一個(gè)任務(wù)，因此掃描指針回零，退出當(dāng)前會(huì)話，等待下次會(huì)話，重新掃描
        i_ScanPtr = 0
        ScanTaskA = True
        Exit Function
    End If
    '======= 沒(méi)有捕獲任務(wù)，將掃描指針前移一個(gè)位置 =======
    i_ScanPtr = i_ScanPtr + 1
    '------- 如果掃描了整個(gè)隊(duì)列也沒(méi)有發(fā)現(xiàn)任務(wù) -------
    If i_ScanPtr >= 16 Then
        '------- 結(jié)束掃描，等待外部觸發(fā) -------
        i_ScanPtr = 0
        ScanTaskA = False
    Else
        '------- 否則的話，繼續(xù)掃描 -------
        GoTo ContinueScan
    End If
End Function
'退出程序，關(guān)閉串口
Private Sub Cmdquit_Click()
  Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
  MSComm1.PortOpen = False
End Sub