form.frm

短信猫开发包 对短信接受读取进行操作

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FormSend 
   Caption         =   "Form1"
   ClientHeight    =   4380
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Rece 
      Caption         =   "汉字接受"
      Height          =   615
      Left            =   360
      TabIndex        =   5
      Top             =   3600
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "文本发送"
      Height          =   495
      Left            =   2880
      TabIndex        =   4
      Top             =   2760
      Width           =   1335
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   3960
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   6
      DTREnable       =   -1  'True
      RTSEnable       =   -1  'True
   End
   Begin VB.TextBox SendTxt 
      Height          =   375
      Left            =   480
      TabIndex        =   3
      Text            =   "如果收到短信,请回复."
      Top             =   1920
      Width           =   3375
   End
   Begin VB.TextBox PhoneNum 
      Height          =   375
      Left            =   480
      TabIndex        =   2
      Text            =   "8613689093454"
      Top             =   1200
      Width           =   3375
   End
   Begin VB.TextBox SmscNum 
      Height          =   375
      Left            =   480
      TabIndex        =   1
      Text            =   "8613800100500"
      Top             =   480
      Width           =   3375
   End
   Begin VB.CommandButton Send 
      Caption         =   "汉字发送"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   2760
      Width           =   1335
   End
End
Attribute VB_Name = "FormSend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
MSComm1.Output = "AT+CMGF=1" + vbCr ''设置发送的模式,注意:一定要加上 vbCr
''MSComm1.Output = "AT+CSCA=" & Chr$(34) & "8613800851500" & Chr$(34) & ",129" + vbCr ''8613010341500是短消息中心,各地的号码不一样,必须设置当地的短消息号码
''MSComm1.Output = "AT+CMGS=" & Chr$(34) & "13689093454" & Chr$(34) & ",129" + vbCr ''13057575064是对方手机号
MSComm1.Output = "AT+CMGS=" & Chr$(34) & "13689093454" & Chr$(34) + vbCr  ''13057575064是对方手机号
''MSComm1.Output = Chr$(34) & "test" & Chr$(34) & Chr$(26) ''chr$(26)是Ctr+ Z
MSComm1.Output = "test" & Chr$(26)  ''chr$(26)是Ctr+ Z
MSComm1.PortOpen = False
End Sub

Private Sub MSComm1_OnComm()
Dim reco
Dim sendsms As Boolean

    Select Case MSComm1.CommEvent
        ' Event messages.
        Case comEvReceive
            reco = MSComm1.Input
            MsgBox reco
            If InStr(reco, "OK") Then sendsms = True
            If InStr(reco, "ERROR") Then sendsms = False

        Case comEvSend
        Case comEvCTS
        Case comEvDSR
        Case comEvCD
        Case comEvRing
        Case comEvEOF

        Case comBreak
        Case comCDTO
        Case comCTSTO
        Case comDCB
        Case comDSRTO
        Case comFrame
        Case comOverrun
        Case comRxOver
        Case comRxParity
        Case comTxFull
        Case Else
    End Select
    


End Sub

Private Sub Rece_Click()
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
MSComm1.Output = "AT+CMGF=1" + vbCr
MSComm1.Output = "AT+CMGR=1" + vbCr
'MSComm1.Output = "AT+CMGD=1" + vbCr
End Sub

Private Sub send_Click()
Dim i As Integer
Dim tmp As Byte
Dim Wd As String

Dim SmsCNumber, PhoneNumber, Message As String
Dim UniSmsc, UniPhoneN, UniMessage As String

Dim SmsC(1 To 12) As Byte
Dim PhoneN(1 To 12) As Byte
Dim Smsc13 As String
Dim PhoneN13 As String

Dim result As String
SmsCNumber = SmscNum.Text
PhoneNumber = PhoneNum.Text
Message = SendTxt.Text

SmsCNumber = SmsCNumber
For i = 1 To 12
    SmsC(i) = Mid(SmsCNumber, i, 1)
Next i
Smsc13 = Mid(SmsCNumber, 13, 1)

PhoneNumber = PhoneNumber
For i = 1 To 12
    PhoneN(i) = Mid(PhoneNumber, i, 1)
Next i
PhoneN13 = Mid(PhoneNumber, 13, 1)

For i = 1 To 6
    tmp = SmsC(i * 2)
    SmsC(i * 2) = SmsC(i * 2 - 1)
    SmsC(i * 2 - 1) = tmp

Next i
For i = 1 To 6
    tmp = PhoneN(i * 2)
    PhoneN(i * 2) = PhoneN(i * 2 - 1)
    PhoneN(i * 2 - 1) = tmp

Next i

UniSmsc = ""
UniPhoneN = ""
UniMessage = ""
For i = 1 To 12
    UniSmsc = UniSmsc + Hex(SmsC(i))
Next i
For i = 1 To 12
    UniPhoneN = UniPhoneN + Hex(PhoneN(i))
Next i

Dim tmpUni As String
For i = 1 To Len(Message)
    Wd = Mid(Message, i, 1)
    tmpUni = Hex(AscW(Wd))
    If Len(tmpUni) = 1 Then tmpUni = "000" + tmpUni
    If Len(tmpUni) = 2 Then tmpUni = "00" + tmpUni
    If Len(tmpUni) = 3 Then tmpUni = "0" + tmpUni
    UniMessage = UniMessage + tmpUni
Next

Dim Length As Integer
Dim UniLen As String
Length = Len(Message) * 2
UniLen = Hex(Length)
If Len(UniLen) = 1 Then UniLen = "0" + UniLen

result = "0891" + UniSmsc + "F" + Smsc13 + "11000D91" + UniPhoneN + "F" + PhoneN13 + "000800" + UniLen + UniMessage


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

MSComm1.Output = "AT+CMGF=0" + vbCr
MSComm1.Output = "AT+CMGS=" & Str(15 + Length) + vbCr
MSComm1.Output = result & Chr$(26)
MSComm1.PortOpen = False
End Sub
'