外网网站牵手内网短信服务

最新推荐文章于 2017-06-26 11:18:49 发布

hhstar

最新推荐文章于 2017-06-26 11:18:49 发布

阅读量1.5k

点赞数

分类专栏：个人研发水文水资源文章标签： webbrowser vb stylesheet vbscript string delphi

本文链接：https://blog.csdn.net/hhstar/article/details/1136502

版权

个人研发同时被 2 个专栏收录

9 篇文章 0 订阅

订阅专栏

水文水资源

8 篇文章 0 订阅

订阅专栏

公司内部有台可以收发短信的计算机，短信包年，也就是说----费用一定，短信条数不限制。
可以收发短信的计算机挂了一个短信模块，但是，被一个（职守的）应用程序24小时占用，看来是没有利用的可能了，非也.
独占的方式着实可恶，不过开发职守软件的程序员非常可爱，开了一个UDP端口的侦听进程。他的程序用Dlphi6做的，显然他的源代码不会给我，我也没有开口要。
一、我要做的是，用VB写一段发送UDP的缎子，实现在内部（局域网）自由发短信息。
首先用我不熟悉的Delphi实现对接，服务端使用的是TIDUDPServer控件，客户端核心代码如下：
-----------------
procedure TForm1.Button1Click(Sender: TObject);
var
str:string;
s:string;
begin
IdUdpClient1.Host:=edit5.Text;
IdUdpClient1.Port:=strtoint(edit6.Text);
IdUdpClient1.Active:=true;

IdUdpClient1.ReceiveTimeout:=5000;

if ((edit1.Text='') or (edit2.Text='') or (edit7.Text='') or (Memo2.Text='')) then
begin
Application.MessageBox(pchar('不能为空！'),'提示',MB_OK+MB_ICONINFORMATION);
exit;
end;

str:='*('+trim(edit1.Text)+';'+trim(edit2.Text)+';'+trim(edit7.Text)+';'+trim(Memo2.Text)+')';
IdUdpClient1.Send(str);
s:= IdUdpClient1.ReceiveString();
Application.MessageBox(pchar(s),'提示',MB_OK+MB_ICONINFORMATION);

end;
---------------
用tIdUdpClient发送数据，由TIDUDPServer接受数据，显然是没有问题。但是我不熟悉Delphi，要进一步开发的话，还是要使用俺熟悉的VB来做，当然VB中没有tIdUdpClient控件，在VB中有类似控件Winsock，选择UDP协议，核心代码如下：
----------------
'<160个字符
Private Sub Command1_Click()
Dim str As String
    str = "admin" & ";" & "admin888" '用户名和口令
    str = "*(" + Trim("admin") + ";" + Trim("admin") + ";" + Trim(Text1.Text) + ";" + Trim(Text2.Text) + ")" '对方手机号码和发送内容
    If Winsock1.State = 0 Then Winsock1.Connect
    'Winsock1.State
    Winsock1.SendData str
    Winsock1.GetData str

End Sub

Private Sub Form_Load()
Winsock1.RemoteHost = "10.xx.xxx.xxx"
Winsock1.RemotePort = 3006
End Sub
-------------------
上面的代码顺利实现了和TIDUDPServer对接的功能，显然也就实现了内部网络用户免费发短信的功能。如此以来，
内部网络应用就多了，比如报警功能：当数据库作用用新记录或者某个特征值达到标准时，自动发短信警告用户，也是不错的应用。
再比如远程控制，当远程RTU使用手机模块的使用，遥测数据或者远程控制，都是可以的。还有个优势是：本短信在移动公司排队靠前，也就是说，响应时间非常快，基本上在秒级。
下面还是回到基本功能应用吧

二、外网发短信息

分析和实现：端口是可以影射的，但是，网络总出口路由器俺控制不了，此路不同。用VNN 实现虚拟网络，做起来很不方便，你需要在外网的计算机上安装VNN 。还是另想办法。思路是：利用租用的虚拟主机网站支持ASP的便利，做一个使用ACCESS的网页，验证用户，然后写入待发送短信息的表中。以上网页的任务完成。扩充上面(一）中提到的VB程序，循环定时获取网站ACCESS中待发送的短信息列表，有新记录时发出。

1、网页的完成
一个ASP的留言板程序，具备填写留言，管理删除留言功能就可以了。网上有很多具备上述功能的留言板ASP源代码。这里只截取部分重要代码，以便说明问题
读取留言，其中手机号码正确的留言（短信息）将被发送，然后程序自动删除该记录。这个程序同时被VB程序调用。
------------
<%@LANGUAGE="VBScript" codepage="936"%>

<%
set rs=server.createobject("adodb.recordset")
sql="select id,user,qq,email,content,data from main order by id desc"
rs.open sql,conn,1,1
%>
<html>
<head>
<title></title>
<link href="style.css" _fcksavedurl=""style.css"" _fcksavedurl=""style.css"" rel="stylesheet" type="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312"></head>
<body>
hhstar
<br>
<%do while not rs.eof%>
<%=rs("id")%>
<br>
<%=rs("user")%>
<br>
<%=rs("qq")%>
<br>
<%=rs("email")%>
<br>
<%=rs("content")%>
<br>

<%
rs.movenext
loop
%>

</body>
</html>
<%
rs.close
set rs=nothing
conn.close
set conn=nothing
%>
-------------
删除记录，被送到短信缓冲区的记录被删除。这个过程被VB程序调用。
----------
<%@LANGUAGE="VBScript" codepage="936"%>
<%if session("admin")<>"" then%>

<%
set rs=server.createobject("adodb.recordset")
id=Request.QueryString("id")
sql="select * from main where id="&id
rs.open sql,conn,2,3
rs.delete
rs.update
%>
<html>
<head>
<title>删除成功！</title>
<link href="style.css" _fcksavedurl=""style.css"" _fcksavedurl=""style.css"" rel="stylesheet" type="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">

</style>
<meta http-equiv="refresh" content="2;URL=mymanage.asp">
</head>
<body>
<div align="center">删除成功，2秒钟后自动跳转到<a href="mymanage.asp">管理员页面</a></div>
</body>
</html>
<%
else
response.Redirect("admin.asp")
end if%>
--------
2、vb程序功能的完善
基本功能是：定时器定时调用上面的代码，监视网站留言，如果发现有符合规则的留言，就认为是需要发送的短信息，提取发送手机号码和内容，写入内部网络短信服务器缓冲区，交服务器发送短信息。这个程序运行在短信服务器上或者内部网络的任何一台计算机上。

核心代码为:
---------------
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'过程的作用是向短信服务器发送网站留言（短信息）内容。
Dim strhttp1() As String
Dim str As String
Dim str1, str2 As String
Dim i As Long

        txtHtml.Text = WebBrowser1.Document.body.innerText
        strhttp1 = Split(txtHtml.Text, vbCrLf)
        If Trim(strhttp1(0)) = "hhstar" Then
            For i = 1 To UBound(strhttp1) - 1 Step 5

                str1 = Trim(strhttp1(i + 3))
                If Len(str1) = 11 And IsNumeric(str1) Then
                    str2 = Trim(strhttp1(i + 4))
                    str = "*(" + Trim("XXXXX") + ";" + Trim("XXXXX") + ";" + Trim(str1) + ";" + Trim(str2) + ")"
                    If Winsock1.State = 0 Then Winsock1.Connect
                    'Winsock1.State
                    Winsock1.SendData str
                    'DoEvents
                    Winsock1.GetData str
                    Debug.Print str

manage Text3.Text & "del.asp?id=" & Trim(strhttp1(i))

                End If
            Next
        End If
End Sub
Private Sub manage(MYurl As String)'这个过程的作用自动以管理员的身份登陆到管理页面并删除已经发送的记录

ReDim aByte(0) As Byte ' Array of bytes to hold data to post

cPostData = "admin=admin&password=xxxxxxx"

PackBytes aByte(), cPostData

Dim vPost As Variant

vPost = aByte ' Assign the byte array to a VARIANT

Dim vHeaders As Variant

vHeaders = "Content-Type: application/x-www-form-urlencoded" + Chr(10) + Chr(13)

      WebBrowser1.Navigate Text3.Text & "checkpass.asp", , , vPost, vHeaders
       DoEvents
       Sleep (100)
     WebBrowser1.Navigate MYurl

End Sub
--------------------
以上VB程序在win2000/2003/XP+VB6下通过,asp代码在IIS6环境和虚拟主机环境下通过。整个过程配合紧密，延时为0.7-3.1秒之间。