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失?。?成功
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失?。?成功
    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