计算机与手机互通短信实现群发问题
各位大哥好：小弟现在在网上下了一个计算机与手机一对一互通短信的源码，我想把它改成一台计算机与手机群发的功能，手机号码可在程序中固定。
如果不行，也可重写，小弟拜上了：）
--------------------编程问答-------------------- 源码如下：
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成功
Private Sub Command1_Click()
RequestRecMsg MsgIndex.Text
End Sub
Private Sub Form_Load()
SmsInit 3, "9600,n,8,1"
End Sub
Private Function SmsInit(Port As Integer, setstr As String) As Boolean
SmsInit = False
If SmsOpen(Port, setstr) = False Then Exit Function
WorkFlag = True
SendSuccessCount = 0
SendFailedCount = 0
ReceiveCount = 0
ReceiveData = ""
SendSuccess = 0
ReceiveSuccess = 0
SmsInit = True
End Function
Private Function SmsSend(MoblieID As String, TxtMessage As String) As Boolean '被timer1_timer调用
Dim TxtMsg As String
SmsSend = False
If WorkFlag = False Or SendSuccess = -1 Then Exit Function
'编码
TxtMsg = Encode(TxtMessage)
If MSComm1.PortOpen Then
MSComm1.Output = "AT+CMGS=" + Chr(34) + MoblieID + Chr(34) + Chr(13) '送出短信目的号码
MSComm1.Output = TxtMsg + Chr(26) '送出已编码后的短信内容
SendSuccess = -1
SmsSend = True
End If
End Function
Function SmsOpen(Port As Integer, Setings As String) As Integer '被opensms_click 调用
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 = "ATE0" + Chr(13) + Chr(10)
MSComm1.RThreshold = 1
MSComm1.Output = "AT+CMGF=1" + Chr(13) + Chr(10)
MSComm1.Output = "AT+CSMP=4,167,0,8" + Chr(13) + Chr(10)
'上边两行语句作为联机是初始化用的命令
End If
Exit Function
ErrHandle:
MsgBox "错误： " + Str(Err.Number) + Chr(13) + Chr(10) + Err.Description, _
vbOKOnly + vbCritical, App.Title
End Function
Private Sub MSComm1_OnComm()
Dim buffer As String
Dim i As Integer, j As Integer
Dim NextFlag As Boolean
ReceiveData = ReceiveData + MSComm1.Input
Do
NextFlag = False
j = InStr(ReceiveData, "+CMS")
If j > 0 Then
ReceiveSuccess = 0
End If
i = InStr(ReceiveData, "+CMGR:")
j = InStr(ReceiveData, "+CMGS")
If j = 0 And i = 0 And Len(ReceiveData) > 8 Then '删除接收区中无用的数据
ReceiveData = Mid(ReceiveData, Len(ReceiveData) - 7)
End If
If j > 0 And j < i And 14 >= Len(ReceiveData) - j Then '最前的数据为发送返回结果
If SendSuccess = -1 Then
buffer = Mid(ReceiveData, j, 14)
If InStr(buffer, "OK") > 0 Then
SendSuccess = 1
SendSuccessCount = SendSuccessCount + 1
Else
SendSuccess = 0
SendFailedCount = SendFailedCount + 1
End If
End If
ReceiveData = Mid(ReceiveData, j + 14)
NextFlag = True
Else
If i > 0 Then
j = InStr(ReceiveData, Chr(13) + Chr(10) + "OK")
If j > 0 Then
buffer = Mid(ReceiveData, i, j - i)
ReceiveSuccess = 0
If Analyze(buffer) Then
ReceiveSuccess = 1 '接收成功
ReceiveCount = ReceiveCount + 1
End If
ReceiveData = Mid(ReceiveData, j + 3)
NextFlag = True
End If
End If
End If
Loop While NextFlag
End Sub
Function Analyze(RecMsg As String) As Boolean
Dim tel As String, msg As String, time As String
Analyze = AnalyzeRecMsg(buffer, tel, msg, time)
If Analyze = True Then
'用户处理
MobileTel.Text = tel
SendMsg.Text = msg
' Label1.Caption = time
End If
End Function
Private Sub Send_Click()
Success = -1
If Len(MobileTel.Text) < 11 Or Len(MobileTel.Text) > 12 Then
MsgBox "请输入正确的手机号"
Exit Sub
End If
If Len(SendMsg.Text) < 1 Or Len(SendMsg.Text) > 80 Then
MsgBox "必须信息或输入的信息不能超过80"
Exit Sub
End If
Status.Panels(2).Text = "正发送..."
SmsSend MobileTel.Text, SendMsg.Text
End Sub
--------------------编程问答-------------------- 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 Function Decode(EncodeMessage As String) As String
Dim Word(2) As Byte
Dim ascii As String
Dim Temp As String
Dim j As Integer, Pos As Integer
Pos = 1
j = 1
Do
If j >= Len(EncodeMessage) Then
Exit Function
End If
ascii = Mid(EncodeMessage, j, 2)
j = j + 2
Word(Pos) = Val("&H" + ascii)
Pos = Pos - 1
If Pos < 0 Then
Temp = Word
Decode = Decode + Left(Temp, 1)
Pos = 1
End If
Loop
End Function
Private Function GetBPNumber(RecDecodeMsg As String) As String
Dim i As Integer
Dim Start As Boolean
Dim OneWord As String
GetBPNumber = ""
Start = False
For i = 1 To Len(RecDecodeMsg)
OneWord = Mid(RecDecodeMsg, i, 1)
If OneWord >= "0" And OneWord <= "9" Then
Start = True
GetBPNumber = GetBPNumber + OneWord
Else
If Start = False Then
If OneWord <> " " Then Exit Function
Else
If OneWord = " " Then
Do
i = i + 1
OneWord = Mid(RecDecodeMsg, i, 1)
Loop While OneWord = " " And i < Len(RecDecodeMsg)
End If
RecDecodeMsg = Mid(RecDecodeMsg, i)
Exit Function
End If
End If
Next i
End Function
Private Function AnalyzeRecMsg(ByVal RecMsg As String, ByRef MobileNumber As String, ByRef msg As String, ByRef MsgTime As String) As Boolean
Dim i As Integer, j As Integer
Dim AnalyzeMsg As String
Dim Length As Integer
AnalyzeRecMsg = False
i = InStr(RecMsg, "+CMGR:")
If i < 1 Then Exit Function
AnalyzeMsg = Mid(RecMsg, i + 6)
i = InStr(AnalyzeMsg, Chr(34) + "+86")
If i < 1 Then Exit Function
j = InStr(i + 1, AnalyzeMsg, Chr(34))
If j < i Then Exit Function
MobileNumber = Mid(AnalyzeMsg, i + 4, j - i - 4)
AnalyzeMsg = Mid(AnalyzeMsg, j)
i = InStr(AnalyzeMsg, ",")
If i < 1 Then Exit Function
i = InStr(i, AnalyzeMsg, ",")
If i < 1 Then Exit Function
i = InStr(i, AnalyzeMsg, Chr(34))
If i < 1 Then Exit Function
j = InStr(i + 1, AnalyzeMsg, Chr(34))
If j < i Then Exit Function
MsgTime = Mid(AnalyzeMsg, i + 1, j - i - 4)
AnalyzeMsg = Mid(AnalyzeMsg, j)
i = InStr(AnalyzeMsg, Chr(13) + Chr(10))
If i < 1 Then Exit Function
j = InStrRev(AnalyzeMsg, ",", i)
If j < 1 Then Exit Function
Length = Val(Mid(AnalyzeMsg, j + 1, i - j - 1))
j = InStr(i + 2, AnalyzeMsg, Chr(13) + Chr(10))
If j < 1 Then Exit Function
msg = Mid(AnalyzeMsg, i + 2, j - i - 2)
If Len(msg) > Length Then
msg = Decode(msg)
End If
AnalyzeRecMsg = True
End Function
Private Function RequestRecMsg(MsgIndex As String) As Boolean
RequestRecMsg = False
If ReceiveSuccess = -1 Then Exit Function
ReceiveSuccess = -1
RequestRecMsg = True
MSComm1.Output = "AT+CSDH=1" + Chr(13) + Chr(10)
MSComm1.Output = "AT+CMGR=" + MsgIndex + Chr(13) + Chr(10)
End Function
Private Function RequestDelMsg(MsgIndex As String)
MSComm1.Output = "AT+CMGD=" + MsgIndex + Chr(13) + Chr(10)
End Function
--------------------编程问答-------------------- UP --------------------编程问答-------------------- 下一项目有一个功能就这个，先学习学习
mark!! --------------------编程问答-------------------- 小子，别在这里制造垃圾短信！我最烦就是手机那些广告信息了 --------------------编程问答-------------------- 该回复被版主删除 --------------------编程问答-------------------- mark --------------------编程问答-------------------- --------------------编程问答-------------------- 标题：硬件短信平台
内容：（一）方寸硬件短信平台
目前硬件短信平台以稳定性、即时性在短信应用市场上牢牢站住脚跟,虽然很多sp短信通道可以选择,但是由于依赖网络,且随着接入的开发商增多,垃圾短信成千上万,而sp商在服务器上的投入并没有增加,导致大部分sp短信通道经常堵塞,在这种情况下一些sp经常去掉开发商提交的短信,严重影响客户的使用,而硬件短信平台却很好解决了这个问题.
1. 无需联网，只需一台电脑，一个短信设备，一个短信开发接口，就可轻松建立短信服务器,可以实现短信查询,短信投票,短信通知等短信应用
2.短信资费由手机卡决定,在手机卡上冲多少发多少,且接受短信不扣费,非常透明
3.一些重要的短信应用,硬件短信平台的稳定性和安全性能够很好的胜任,而sp短信通道确不具备
（二）短信数据库接口
通过方寸短信数据库接口，能使现有的系统（如OA、CRM、ERP等系统）轻松实现无线办公功能，无论用的是哪种开发语言（VB\VC\VFP\asp\jsp\java\pb\delphi...），只要系统能读写数据库即可对接！仅需要在指定的表中添加记录，接口程序就自动进行发送短信了，收到的短信会自动保存到数据库里,所以，不需要了解任何有关数据通信方面的知识，就可实现手机短信的收发等功能！
（三）方寸科技的优势
深圳方寸科技有限公司是一家专门从事无线通信和互联网应用方面软、硬件产品开发和销售的高科技公司，致力于为企业提供无线移动数据产品、互联网应用系统、信息化平台的应用服务和解决方案。
我们的硬件短信平台可以持续稳定运行,适合各种管理软件的短信方面的需求
网址∶http://www.fcwww.com/
联系人∶陈生
电话∶0755-25996144
QQ∶393376247
--------------------编程问答-------------------- 虽然垃圾短信有点可耻,但vb 的程序可以学习一下啊 --------------------编程问答-------------------- 能发一个还不能发多个啊！不是一回事啊！只是把电话号码改一下不就行了吗？ --------------------编程问答-------------------- 顶，看大侠的修改~ --------------------编程问答-------------------- --------------------编程问答-------------------- --------------------编程问答-------------------- 群发其实也是一个一个的发，使用循环一个一个的发即可。
补充：VB , COM/DCOM/COM+
