|
|
亿华科技=>>短信猫开发包【VB版】
|
短信开发VB实例代码（部分）
|
VERSION 5.00
Object = "{229E7C52-466B-4152-BB2D-96087542B9BA}#10.0#0"; "szhto.ocx"
Begin VB.Form Form1
Caption = "亿华科技工业MODEM短信 Demo"
ClientHeight = 7530
ClientLeft = 60
ClientTop = 450
ClientWidth = 8760
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7530
ScaleWidth = 8760
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text20
Height = 330
Left = 7710
TabIndex = 55
Text = "12"
Top = 6930
Width = 510
End
Begin VB.TextBox Text19
Height = 330
Left = 4605
TabIndex = 52
Text = "1,2,363333659395133591#"
Top = 6960
Width = 2580
End
Begin VB.TextBox Text18
Height = 330
Left = 2985
TabIndex = 50
Text = "4"
Top = 6930
Width = 450
End
Begin VB.TextBox Text17
Height = 330
Left = 1155
TabIndex = 48
Text = "13890148810#"
Top = 6870
Width = 1320
End
Begin VB.TextBox Text16
Height = 330
Left = 8205
TabIndex = 46
Text = "4"
Top = 6360
Width = 420
End
Begin VB.TextBox Text15
Height = 405
Left = 7185
TabIndex = 44
Text = "1"
Top = 6360
Width = 495
End
Begin VB.TextBox Text14
Height = 375
Left = 5625
TabIndex = 42
Text = "4"
Top = 6383
Width = 480
End
Begin VB.TextBox Text13
Height = 390
Left = 4635
TabIndex = 40
Text = "1"
Top = 6375
Width = 495
End
Begin VB.TextBox Text12
Height = 345
Left = 2970
TabIndex = 38
Text = "4"
Top = 6405
Width = 450
End
Begin VB.TextBox Text11
Height = 345
Left = 1140
TabIndex = 35
Text = "13800138000"
Top = 6398
Width = 1305
End
Begin VB.CommandButton Command7
Caption = "充值测试"
Height = 480
Left = 75
TabIndex = 34
Top = 6330
Width = 570
End
Begin VB.Frame Frame4
Caption = "待发手机列表"
Height = 6060
Left = 60
TabIndex = 17
Top = 120
Width = 2430
Begin Szhto.SzhtoSms SzhtoSms1
Left = 1815
Top = 180
_ExtentX = 873
_ExtentY = 873
End
Begin VB.TextBox Text10
Height = 2055
Left = 90
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 32
Top = 3315
Width = 2190
End
Begin VB.CommandButton Command5
Caption = "添加"
Height = 345
Left = 1845
TabIndex = 20
Top = 5475
Width = 510
End
Begin VB.TextBox Text7
Height = 360
Left = 675
TabIndex = 19
Text = "输入手机号"
Top = 5460
Width = 1170
End
Begin VB.ListBox List1
Height = 2580
Left = 75
TabIndex = 18
Top = 300
Width = 2220
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "发送状态"
Height = 195
Left = 90
TabIndex = 31
Top = 3045
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "手机号"
Height = 180
Left = 75
TabIndex = 21
Top = 5535
Width = 540
End
End
Begin VB.Frame Frame3
Caption = "AT指令"
Height = 810
Left = 2550
TabIndex = 14
Top = 5325
Width = 6060
Begin VB.CommandButton Command4
Caption = "测试"
Height = 390
Left = 5205
TabIndex = 16
Top = 270
Width = 750
End
Begin VB.TextBox Text6
Height = 360
Left = 105
TabIndex = 15
Top = 285
Width = 5010
End
End
Begin VB.Frame Frame2
Caption = "接收信息"
Height = 2520
Left = 2535
TabIndex = 6
Top = 2715
Width = 6075
Begin VB.CommandButton Command6
Caption = "删除"
Height = 405
Left = 5205
TabIndex = 25
Top = 855
Width = 750
End
Begin VB.TextBox Text5
Alignment = 2 'Center
Height = 270
Left = 5190
TabIndex = 12
Text = "0"
Top = 1815
Width = 765
End
Begin VB.CommandButton Command2
Caption = "接收"
Height = 435
Left = 5190
TabIndex = 8
Top = 270
Width = 750
End
Begin VB.TextBox Text2
Height = 1845
Left = 105
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 300
Width = 5025
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "状态："
Height = 180
Left = 105
TabIndex = 22
Top = 2235
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "-1为新到短信，0为所有短信"
Height = 180
Left = 3720
TabIndex = 13
Top = 2220
Width = 2250
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "短信位置"
Height = 180
Left = 5205
TabIndex = 11
Top = 1575
Width = 720
End
End
Begin VB.Frame Frame1
Caption = "发送信息"
Height = 2490
Left = 2490
TabIndex = 0
Top = 120
Width = 6090
Begin VB.TextBox Text9
Height = 270
Left = 690
TabIndex = 30
Top = 285
Width = 2010
End
Begin VB.CheckBox Check3
Caption = "SP短信"
Height = 180
Left = 5175
TabIndex = 28
Top = 1635
Width = 840
End
Begin VB.TextBox Text8
Height = 330
Left = 3690
TabIndex = 26
Text = "9600,N,8,1"
Top = 225
Width = 1410
End
Begin VB.CheckBox Check2
Caption = "16进制"
Height = 210
Left = 5175
TabIndex = 24
Top = 1365
Width = 885
End
Begin VB.CheckBox Check1
Caption = "闪信"
Height = 225
Left = 5160
TabIndex = 23
Top = 1050
Width = 735
End
Begin VB.CommandButton Command3
Caption = "打开端口"
Height = 795
Left = 5160
TabIndex = 10
Top = 195
Width = 840
End
Begin VB.TextBox Text4
Height = 330
Left = 3675
TabIndex = 9
Text = "1"
Top = 660
Width = 1425
End
Begin VB.TextBox Text3
Height = 330
Left = 705
TabIndex = 4
Text = "13800816500"
Top = 645
Width = 1980
End
Begin VB.TextBox Text1
Height = 1290
Left = 90
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 1035
Width = 5025
End
Begin VB.CommandButton Command1
Caption = "发短信"
Height = 390
Left = 5160
TabIndex = 1
Top = 1920
Width = 825
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "发送短信字符数：0"
Height = 180
Left = 2370
TabIndex = 33
Top = 0
Width = 1530
End
Begin VB.Label Label8
Caption = "注册码"
Height = 180
Left = 120
TabIndex = 29
Top = 375
Width = 540
End
Begin VB.Label Label7
Caption = "配制"
Height = 180
Left = 3150
TabIndex = 27
Top = 330
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "端口"
Height = 180
Left = 3165
TabIndex = 5
Top = 690
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "中心号"
Height = 180
Left = 105
TabIndex = 3
Top = 735
Width = 540
End
End
Begin VB.Label Label22
AutoSize = -1 'True
Caption = "延时"
Height = 180
Left = 7260
TabIndex = 54
Top = 7005
Width = 360
End
Begin VB.Label Label21
Caption = "挂断"
Height = 240
Left = 8280
TabIndex = 53
Top = 6975
Width = 450
End
Begin VB.Label Label20
AutoSize = -1 'True
Caption = "延时"
Height = 180
Left = 2520
TabIndex = 51
Top = 7005
Width = 360
End
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "延时"
Height = 180
Left = 7755
TabIndex = 49
Top = 6435
Width = 360
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "延时"
Height = 180
Left = 5250
TabIndex = 47
Top = 6480
Width = 360
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "延时"
Height = 180
Left = 2535
TabIndex = 45
Top = 6480
Width = 360
End
Begin VB.Label Label15
Caption = "密码"
Height = 180
Left = 4140
TabIndex = 43
Top = 7050
Width = 360
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "充值手机"
Height = 180
Left = 300
TabIndex = 41
Top = 6975
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "充值"
Height = 180
Left = 6750
TabIndex = 39
Top = 6465
Width = 360
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "语言"
Height = 180
Left = 4215
TabIndex = 37
Top = 6480
Width = 360
End
Begin VB.Label Label11
Caption = "电话"
Height = 240
Left = 720
TabIndex = 36
Top = 6450
Width = 375
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount Lib "kernel32" () As Long
'//////////////////////////////////////////////////////////////
'延时若干毫秒
'//////////////////////////////////////////////////////////////
Private Sub Delay(DT As Long)
Dim T As Long
On Error Resume Next
T = GetTickCount()
Do
DoEvents
Loop Until GetTickCount - T > DT
End Sub
Private Sub Check1_Click()
'设置是否闪信 SMSFLASH 为真是是闪信
If Check1.Value = 1 Then SzhtoSms1.SmsFlash = True Else
SzhtoSms1.SmsFlash = False
End Sub
Private Sub Command3_Click()
'打开短信初始化端口
Dim Temp As String
Dim Aa As String
Aa = Now
Label6.Caption = "打开始打端口..."
Temp = SzhtoSms1.YhOpenModem(Text4.Text, Text8, Text9)
If InStr(Temp, "失败") = 0 Then Text3 = Temp
Label6.Caption = "打开:" + IIf(InStr(Temp, "失败") > 0, "失败", "成功")
Debug.Print DateDiff("s", Aa, Now)
End Sub
Private Sub Command1_Click()
'发送短信
Label6.Caption = "开始发送短信..."
Command1.Enabled = False
Text10 = ""
If SzhtoSms1.smsStatus <> "" Then Exit Sub
Dim I As Long
For I = 0 To List1.ListCount - 1
Text10 = Text10 + "状态:" + SzhtoSms1.YhSendSms(Text3.Text,
List1.List(I), Text1.Text, IIf(Check2.Value = 1, 9, IIf(Check3.Value =
1, 1, 0))) + " 手号:" + List1.List(I) + Chr$(13) + Chr$(10)
Next I
Command1.Enabled = True
Label6.Caption = "结束发送"
End Sub
Private Sub Command2_Click()
'接收短信
If SzhtoSms1.smsStatus <> "" Then Exit Sub
Label6.Caption = "开始接收短信..."
Dim sId() As String
Dim SCN() As String
Dim sTl() As String
Dim SDT() As String
Dim sCon() As String
Text2 = SzhtoSms1.YhReadSms(Text5.Text, "")
Text2 = ""
If Val(Text5.Text) > 1 Then
'单条短信显示
Text2 = Text2 + "存放序号：" + SzhtoSms1.RsId + Chr(13) + Chr(10)
Text2 = Text2 + "短信中心：" + SzhtoSms1.RsCenterNo + Chr(13) + Chr(10)
Text2 = Text2 + "对方手机：" + SzhtoSms1.RsTel + Chr(13) + Chr(10)
Text2 = Text2 + "接收日期：" + SzhtoSms1.RsDate + Chr(13) + Chr(10)
Text2 = Text2 + "短信内容：" + SzhtoSms1.RsCon + Chr(13) + Chr(10)
Text2 = Text2 + "=====================================" + Chr(13) +
Chr(10)
Else
'多条短提取
If SzhtoSms1.RsId = "" Then GoTo A1
sId = Split(SzhtoSms1.RsId, Chr$(11))
SCN = Split(SzhtoSms1.RsCenterNo, Chr$(11))
sTl = Split(SzhtoSms1.RsTel, Chr$(11))
SDT = Split(SzhtoSms1.RsDate, Chr$(11))
sCon = Split(SzhtoSms1.RsCon, Chr$(11))
Dim I As Long
For I = 0 To UBound(sCon)
Text2 = Text2 + "存放序号：" + sId(I) + Chr(13) + Chr(10)
Text2 = Text2 + "短信中心：" + SCN(I) + Chr(13) + Chr(10)
Text2 = Text2 + "对方手机：" + sTl(I) + Chr(13) + Chr(10)
Text2 = Text2 + "接收日期：" + SDT(I) + Chr(13) + Chr(10)
Text2 = Text2 + "短信内容：" + sCon(I) + Chr(13) + Chr(10)
Text2 = Text2 + "=====================================" + Chr(13) +
Chr(10)
Next I
End If
A1:
Label6.Caption = "操作结束"
Debug.Print Aa
End Sub
Private Sub Command4_Click()
'AT指令测试
If SzhtoSms1.smsStatus <> "" Then Exit Sub
Label6.Caption = "开始AT指令测试"
Text2 = SzhtoSms1.YhATCommand(Text6.Text)
Label6.Caption = "操作结束"
End Sub
Private Sub Command6_Click()
If SzhtoSms1.smsStatus <> "" Then Exit Sub
Label6.Caption = "开始删除"
Label6.Caption = SzhtoSms1.YhDelSms(Text5)
End Sub
Private Sub Command7_Click()
Dim Keys As String
Label6.Caption = "打电话"
Keys = Text11 + "," + Text12 + "," + Text13 + "," + Text14 + "," +
Text15 + "," + Text16 + "," + Text17 + "," + Text18 + "," + Text19 +
"," + Text20 + ",*END*"
Label6.Caption = "打电话状态:" + SzhtoSms1.TaoCan(Keys)
End Sub
Private Sub SzhtoSms1_NewRing(iTel As String, iDate As String)
Text2 = Text2 + iTel + "{" + iDate + "}"
End Sub
Private Sub SzhtoSms1_NewSms(iSms As String, sId As String, sCenterNo
As String, sTel As String, sDate As String, sCon As String)
Dim Id() As String
Dim CN() As String
Dim Tl() As String
Dim DT() As String
Dim Con() As String
'多条短提取
Id = Split(sId, Chr$(11))
CN = Split(sCenterNo, Chr$(11))
Tl = Split(sTel, Chr$(11))
DT = Split(sDate, Chr$(11))
Con = Split(sCon, Chr$(11))
Dim I As Long
For I = 0 To UBound(Con)
Text2 = Text2 + "存放序号：" + Id(I) + Chr(13) + Chr(10)
Text2 = Text2 + "短信中心：" + CN(I) + Chr(13) + Chr(10)
Text2 = Text2 + "对方手机：" + Tl(I) + Chr(13) + Chr(10)
Text2 = Text2 + "接收日期：" + DT(I) + Chr(13) + Chr(10)
Text2 = Text2 + "短信内容：" + Con(I) + Chr(13) + Chr(10)
Text2 = Text2 + "=====================================" + Chr(13) +
Chr(10)
Next I
'收到短信后自动回复
'Call SzhtoSms1.YhSendSms(Text3, "13713855661", "自动转发！" + sCon, 0)
End Sub
Private Sub SzhtoSms1_SmsReport(SmsID As String, sTel As String,
ToCenterDate As String, ToUserDate As String, iLog As String)
Text2 = Text2 + "短信回报:ID" + SmsID + Chr(13) + Chr(10) + "电话:" + sTel +
Chr(13) + Chr(10) + "送达时间" + ToCenterDate + Chr(13) + Chr(10) + "查看日期"
+ ToUserDate + Chr(13) + Chr(10) + "状态:" + iLog + Chr(13) + Chr(10)
End Sub
Private Sub Text1_Change()
'显示短信字数
Label10.Caption = "发送短信字符数：" + CStr(Len(Text1))
End Sub
Private Sub Form_Unload(Cancel As Integer)
'关闭短信端口
Label6.Caption = "开始关闭"
Label6.Caption = "关闭:" + SzhtoSms1.YhCloseModem
If SzhtoSms1.smsStatus <> "" Then
Cancel = True
End If
End Sub
'以上为所有短信发送功能介绍
'以下为短信增加发送电话号码管理
Private Sub Command5_Click()
'加入电话号码 '增加发送短信的列表
Dim I As Long
Dim Temp As String
DHHM = Trim$(Text7)
If Len(DHHM) < 11 Then If MsgBox("手机电话号码长度应为11位,是否要支持添加！", vbYesNo) =
vbNo Then Exit Sub
For I = 0 To List1.ListCount - 1
Temp = Trim$(Left(Trim$(List1.List(I)), 11))
If Left(DHHM, 11) = Temp Then Label6.Caption = "手机电话号码已经在列表中": Exit
Sub
Next I
List1.AddItem DHHM
Text7.Text = ""
End Sub
Private Sub List1_Click()
'显示已选电话号码
Text7 = List1.List(List1.ListIndex)
End Sub
Private Sub List1_DblClick()
'移出已选电话号码
List1.RemoveItem List1.ListIndex
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command5_Click
End Sub
|
|
