📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "msg"
ClientHeight = 8100
ClientLeft = 2295
ClientTop = 1320
ClientWidth = 10230
LinkTopic = "Form1"
ScaleHeight = 8100
ScaleWidth = 10230
Begin VB.ListBox List3
Height = 1620
ItemData = "Form1.frx":0000
Left = 120
List = "Form1.frx":0002
TabIndex = 19
Top = 5280
Width = 6615
End
Begin VB.ListBox List2
Height = 1620
ItemData = "Form1.frx":0004
Left = 120
List = "Form1.frx":0006
TabIndex = 18
Top = 2400
Width = 6495
End
Begin VB.Timer Timer1
Left = 4200
Top = 120
End
Begin MSCommLib.MSComm MSComm1
Left = 3120
Top = 0
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 5
DTREnable = -1 'True
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 9480
Top = 1560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command11
Caption = "确认"
Height = 375
Left = 7200
TabIndex = 16
Top = 7080
Width = 615
End
Begin VB.CommandButton Command10
Caption = "删除"
Height = 375
Left = 8640
TabIndex = 15
Top = 7080
Width = 615
End
Begin VB.CommandButton Command9
Caption = "添加"
Height = 375
Left = 7920
TabIndex = 14
Top = 7080
Width = 615
End
Begin VB.ListBox List1
Height = 6105
ItemData = "Form1.frx":0008
Left = 7200
List = "Form1.frx":000A
TabIndex = 13
Top = 720
Width = 1935
End
Begin VB.CommandButton Command8
Caption = "查询"
Height = 495
Left = 4920
TabIndex = 11
Top = 7080
Width = 1215
End
Begin VB.CommandButton Command7
Caption = "删除"
Height = 495
Left = 3240
TabIndex = 10
Top = 7080
Width = 1095
End
Begin VB.CommandButton Command6
Caption = "回复"
Height = 495
Left = 1560
TabIndex = 9
Top = 7080
Width = 1215
End
Begin VB.CommandButton Command5
Caption = "接收"
Height = 495
Left = 120
TabIndex = 8
Top = 7080
Width = 1095
End
Begin VB.CommandButton Command4
Caption = "查询"
Height = 495
Left = 4920
TabIndex = 6
Top = 4200
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "删除"
Height = 495
Left = 3360
TabIndex = 5
Top = 4200
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "重发"
Height = 495
Left = 1680
TabIndex = 4
Top = 4200
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "发送"
Height = 495
Left = 120
TabIndex = 3
Top = 4200
Width = 1095
End
Begin VB.TextBox Text1
Height = 855
Left = 120
TabIndex = 1
Top = 720
Width = 6375
End
Begin VB.Label Label5
Height = 375
Left = 0
TabIndex = 17
Top = 7800
Width = 10215
End
Begin VB.Label Label4
Caption = "通讯录"
Height = 375
Left = 7200
TabIndex = 12
Top = 240
Width = 1575
End
Begin VB.Label Label3
Caption = "收件箱"
Height = 255
Left = 120
TabIndex = 7
Top = 5040
Width = 1815
End
Begin VB.Label Label2
Caption = "发件箱"
Height = 255
Left = 120
TabIndex = 2
Top = 1920
Width = 1815
End
Begin VB.Label Label1
Caption = "联系人"
Height = 255
Left = 120
TabIndex = 0
Top = 240
Width = 1695
End
Begin VB.Menu MenuFile
Caption = "File(F)"
Begin VB.Menu FileNew
Caption = "New"
Shortcut = ^F
End
Begin VB.Menu FileQxit
Caption = "Qxit"
Shortcut = ^Q
End
End
Begin VB.Menu MenuDele
Caption = "Dele(D)"
Begin VB.Menu DeleAll
Caption = "All"
Shortcut = ^A
End
Begin VB.Menu DeleS
Caption = "Single"
Shortcut = ^I
End
End
Begin VB.Menu MenuHelp
Caption = "Help(H)"
Begin VB.Menu HelpReadMe
Caption = "ReadMe"
End
Begin VB.Menu HelpAbout
Caption = "About"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public flag As Integer
Dim phonenum(20, 1) As String
Public FindFile As String
Const prex = "0891"
Const midx = "11000D91"
Const sufx = "000800"
Dim filename As String '要打开或保存的文件名路径
Dim csca As String
Dim num As String
Dim msg As String
Dim buff As String
Private Sub sendsms() '短消息发送子函数
Dim length As Integer
Dim psmsc As String
Dim pnum As String
Dim pmsg As String
Dim leng As String
Dim pdu As String
Dim buf As String
csca = "+8613800769500" '信息中心号码
length = Len(msg)
length = 2 * length
leng = Hex(length)
If length < 16 Then leng = "0" & leng
psmsc = Trim(numchg(csca))
pnum = Trim(numchg(num))
pmsg = Trim(msgchg(msg))
pdu = prex & psmsc & midx & pnum & sufx & leng & pmsg
MSComm1.RThreshold = 0 '不触发OnComm事件!
MSComm1.Output = "AT+CMGF=0" + vbCr
Call delay(1)
MSComm1.Output = "AT+CMGS=" & str(15 + length) + vbCr
Call delay(1)
MSComm1.Output = pdu
Call delay(1)
MSComm1.Output = Chr$(26)
Call delay(1)
buf = MSComm1.Input
If InStr(buf, "OK") Then
MsgBox "发送成功", vbInformation, "系统消息"
ElseIf InStr(buf, "ERROR") Then
MsgBox "发送失败", vbInformation, "系统消息"
End If
Call delay(2)
MSComm1.OutBufferCount = 0 '清空发送缓冲区
MSComm1.InBufferCount = 0 '清空接收缓冲区
MSComm1.RThreshold = 17 '触发事件OnComm事件
End Sub
Public Function msgchg(smsg As String) As String '发送内容转制子函数
Dim si As Integer
Dim sb As Integer
Dim stmp As Integer
Dim stemp As String
sb = Len(smsg)
msgchg = ""
For si = 1 To sb
stmp = AscW(Mid(smsg, si, 1))
If Abs(stmp) < 127 Then
stemp = "00" & Hex(stmp)
Else
stemp = Hex(stmp)
End If
msgchg = msgchg & stemp
Next si
msgchg = Trim(msgchg)
End Function
Public Function numchg(num As String) As String '号码转制子函数
Dim t1 As Integer
Dim ti As Integer
Dim ltem As String
Dim rtem As String
Dim ttem As String
ttem = ""
t1 = Len(num)
If t1 < 11 And t1 > 13 Then
MsgBox "号码错误!"
Exit Function
End If
If t1 = 11 Then
t1 = t1 + 2
num = "86" & num
End If
For ti = 1 To t1 Step 2
ltem = Mid(num, ti, 1)
rtem = Mid(num, ti + 1, 1)
If ti = t1 Then rtem = "F"
ttem = ttem & rtem & ltem
Next ti
numchg = ttem
End Function
Public Sub delay(pausetime As Single) '延时子函数
Dim start
start = Timer
Do While Timer < start + pausetime
DoEvents
Loop
End Sub
Public Sub break(stri As String, leng As Integer, a As String, b As String)
Dim i As Integer
Dim st As String
For i = 1 To leng Step 1
st = Mid(stri, i, 1)
If st = " " Then
Exit For
End If
Next
leng = Len(stri) 'VB里面用LENB()算汉字的话一个汉字占两个字符,但在其它VB函数里面一个汉字还是一个字符,所以用LEN()重新计算
a = Left$(stri, i - 1)
b = Right$(stri, leng - i)
stri = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -