fasong.frm

通过串口

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "Mscomm32.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3435
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3435
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "待初始化"
      Height          =   1695
      Left            =   2520
      TabIndex        =   6
      Top             =   960
      Width           =   1935
      Begin VB.ComboBox Combo3 
         Height          =   300
         ItemData        =   "fasong.frx":0000
         Left            =   240
         List            =   "fasong.frx":0002
         TabIndex        =   8
         Text            =   "9600"
         Top             =   960
         Width           =   1455
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         ItemData        =   "fasong.frx":0004
         Left            =   240
         List            =   "fasong.frx":001A
         TabIndex        =   7
         Text            =   "COM1"
         Top             =   360
         Width           =   1455
      End
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "fasong.frx":0042
      Left            =   1320
      List            =   "fasong.frx":0049
      TabIndex        =   3
      Top             =   120
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "发送"
      Height          =   495
      Left            =   480
      TabIndex        =   2
      Top             =   2760
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "初始化"
      Height          =   495
      Left            =   3000
      TabIndex        =   1
      Top             =   2760
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   1335
      Left            =   120
      TabIndex        =   0
      Top             =   1320
      Width           =   2055
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   3960
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label Label2 
      Caption         =   "短信内容"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   720
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "手机号"
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SendSuccessCount As Integer  '   发送成功数
Dim SendFailedCount As Integer  '   发送失败数
'Dim ReceiveCount As Integer  '   接收数量
Dim WorkFlag As Boolean  '   工作标记
'Dim ReceiveData As String  '   收到数据
Dim SendSuccess As Integer  '   发送状态：-1等待；0失败；1成功
'Dim ReceiveSuccess As Integer  '   接收状态：-1等待；0失败；1成功
Dim Qbuffer As String            'Q收到数据
Dim Flag As Boolean

Private Sub Command1_Click()


    Dim COM As Integer

On Error GoTo Err

    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    Flag = False
    COM = Right(Combo2.Text, 1)
CSH:
    MSComm1.CommPort = COM
    MSComm1.PortOpen = True '打开端口
   SmsInit COM, "9600,n,8,1"  '设置端口：1，波特率：9600，奇偶校验：No，数据位：8位，停止位：1位
    Frame1.Caption = "初始化完成"
    MSComm1.Output = "AT" + Chr(13) + Chr(10) '唤醒模块
'    If Check1.Value = 1 Then Ys (0.5)
    Combo1.Text = "COM" & COM
    Exit Sub
Err:
    Frame1.Caption = "初始化失败"

End Sub
Private Function SmsInit(Port As Integer, setstr As String) As Boolean 'SmsInit 布尔型，检查端口，初始化
    SmsInit = False '先把它设为布尔“假”
    If SmsOpen(Port, setstr) = False Then Exit Function '检查？？？
    WorkFlag = True '把发送标志设为真，（在发送前要看发送标记是否为真，以说明SMS卡已初始化）

'以下均为初始化
    SendSuccessCount = 0 '   发送成功数
    SendFailedCount = 0  '   发送失败数
'    ReceiveCount = 0     '   接收数量
'    ReceiveData = ""     '   收到数据
    SendSuccess = 0      '   发送状态：-1等待；0失败；1成功
'    ReceiveSuccess = 0   '   接收状态：-1等待；0失败；1成功
    SmsInit = True       '   初始化完成
End Function
Function SmsOpen(Port As Integer, Setings As String) As Boolean     ' 设置端口和初始化 模块

On Error GoTo ErrHandle
  SmsOpen = False '先设为假
  If MSComm1.PortOpen Then MSComm1.PortOpen = False '如果端口已打开，则关闭端口
  MSComm1.CommPort = Port '设置端口号
  MSComm1.Settings = Setings '设置端口工作状态
  MSComm1.PortOpen = True '打开端口
    
  If MSComm1.PortOpen Then
    SmsOpen = True
    MSComm1.Output = "AT" + Chr(13) + Chr(10) '唤醒模块
'    If Check1.Value = 1 Then Ys (0.5)
    MSComm1.Output = "ATE0" + Chr(13) + Chr(10) '关闭回显
'    If Check1.Value = 1 Then Ys (0.5)
    MSComm1.RThreshold = 1 '设置/返回要接受的字符数
    '短信格式分为Text和PDU模式，0为文本，1为PDU：MSComm1.InputMode
    MSComm1.Output = "AT+CMGF=1" + Chr(13) + Chr(10)    ' 选择短消息支持格式（TEXT or PDU）
'    If Check1.Value = 1 Then Ys (0.5)
     
     '设置文本模式的参数。(4,167,0,8)(53,167,,0)(17,167,0,8)
    MSComm1.Output = "AT+CSMP=17,167,0,8" + Chr(13) + Chr(10)     '设置在TEXT模式下条件参数
'    If Check1.Value = 1 Then Ys (0.5)
  End If
  Exit Function
  
ErrHandle:
  MsgBox "错误：  " + Str(Err.Number) + Chr(13) + Chr(10) + Err.Description, _
          vbOKOnly + vbCritical, App.Title        '提示用户注意您不能或不想处理的错误
End Function



Private Sub Command2_Click()
  If Len(Combo1.Text) < 11 Or Len(Combo1.Text) > 12 Then
    MsgBox "请输入正确的手机号"
    Exit Sub
  End If
  If Len(Text1.Text) < 1 Or Len(Text1.Text) > 80 Then
    MsgBox "必须信息或输入的信息不能超过80"
    Exit Sub
  End If
'  Status.Panels(2).Text = "正发送..."
 SmsSend Combo1.Text, Text1.Text

End Sub
Private Sub MSComm1_OnComm() '当发送或接收缓冲区有发送或接收的信息时触发
'MSComm1.RThreshold = 0 不产生MSComm事件，MSComm1.RThreshold = 1 产生MSComm事件
    Dim buffer As String
    Dim i As Integer, j As Integer, n As Integer
    Dim NextFlag As Boolean
    Dim fan As String
'buffer为缓冲器，NextFlag为下一个的标志
    Dim MscInput As String
    MscInput = MSComm1.Input
  ReceiveData = ReceiveData + MscInput
  Text1.Text = Text1.Text + MscInput

  If Flag = False Then
    i = InStr(ReceiveData, "OK")                                  '正常
    j = InStr(ReceiveData, "CMGS")                                      '发送短消息

    If i > 0 And j = 0 Then ReceiveData = Mid(ReceiveData, i + 2)
    If j > 0 And i > j And SendSuccess = -1 Then
          SendSuccess = 1
           SendSuccessCount = SendSuccessCount + 1
          Status.Panels(4) = "成功"
          Status.Panels(6) = SendSuccessCount
          Timer1.Enabled = False
    ElseIf InStr(ReceiveData, "ERROR") Then '         否则视为发送失败，发送失败数加一
      Timer1.Enabled = False
      SendSuccess = 0
      SendFailedCount = SendFailedCount + 1
      Status.Panels(7) = SendFailedCount
    End If
    NextFlag = True
  Else


  End If
End Sub

Private Function SmsSend(MoblieID As String, TxtMessage As String) As Boolean '   发送
    Dim TxtMsg As String

'    SmsSend = False
    '工作标志为“假”或发送状态为（-1）等待时退出
'    If WorkFlag = False Or SendSuccess = -1 Then
'      Status.Panels(2) = "失败"
'      Exit Function
'    End If
    TxtMsg = Encode(TxtMessage)    '编码
    
    If MSComm1.PortOpen Then
      MSComm1.Output = "AT+CMGS=" + Chr(34) + MoblieID + Chr(34) + Chr(13)  '送出短信目的号码
'      If Check1.Value = 1 Then Ys (0.5)
      MSComm1.Output = TxtMsg + Chr(26)   '送出已编码后的短信内容
'      If Check1.Value = 1 Then Ys (0.5)
      SendSuccess = -1 '发送状态为等待
      SmsSend = True '发送完成
'      Status.Panels(2) = "发送完成"
'      Status.Panels(4) = "等待中..."
    End If
'    Timer1.Enabled = True
End Function
Private Function Encode(TxtMessage As String) As String '编码
    Dim High As String, Low As String, OneWord As String
    Dim i As Integer
    For i = 1 To Len(TxtMessage)        '将短信息转化为编码
        OneWord = Mid(TxtMessage, i, 1)
        Low = Hex(AscB(MidB(OneWord, 1, 1)))
        High = Hex(AscB(MidB(OneWord, 2, 1)))
        If Len(High) = 1 Then High = "0" + High
        If Len(Low) = 1 Then Low = "0" + Low
        Encode = Encode + High + Low     '得到的编码
    Next i
End Function
Private Sub Form_Unload(Cancel As Integer)

  If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub