学习ASP在数学建模中的基础应用

　曾编了一个程序，应用于数学建模的数据提取阶段。现归纳如下,思路写得比较详细,看起来像教程-_-。

　　目的是做一个BBS的流量统计，需要分析的数据是每一分钟之内，有哪些ID在线，这些ID的IP是多少，并且要求ID与IP一一对应，不能有重复ID和重复IP,并要求每一分钟生成一个矩阵,分别是ID IPA段 IPB段 IPC段 IPD段, 并存成文本文件, 文件名为hh:mm格式. 然后把这些文本文件导入MatLab进行分析处理,现讨论前面的数据获得阶段的实现方法。

　　数据源从http://bbs.pku.edu.cn/cgi-bin/bbsusr?to=*获得（北大的服务器比较烂，今天就上不去）

　　1，首先数据需要下载，这里采用Msxml2.ServerXMLHTTP控件来进行异步下载获得数据源，之所以不用Microsoft.XMLHTTP是因为Msxml2.ServerXMLHTTP这个控件可以设定超时时间。这完全是开发SXNA过程中得到的启发。由于数据源的特点是数据量在随时变化，不固定容量，所以有必要设定超时。否则程序将不能正确执行容易导致死机。

　　2，其次需要每一分钟自动下载一遍数据源，并要求按时间精确存储。也就是说必须每一分钟自动驱动一遍下载程序，这就要求程序能够实现自动刷新功能。自动刷新功能的实现有多种方法，最基础的是使用meta标签实现refresh，但是本程序要求精确控制时间下载，必须在每一分钟内保证有一次下载，所以meta标签不适用于此程序。其他的方法还有诸如javascript里面的reload方法，window.location.href方法等等，考虑到兼容性的问题选用window.location.href来实现自动驱动。SXNA中的数据更新也用的差不多这种方法。

　　3，为实现每一分钟自动下载需要记录下次下载的时间，存在application("mytime")里面，然后用Javascript的Settimeout判断这次的时间是否到达下次下载时间，并把当前剩余时间显示在屏幕上，如果达到了下载时间，则自动刷新驱动程序。这里面有一个问题，就是Javascript只认得RFC的时间,所以还要用一个ISOtoRFC的时间转换子程序。当每一次驱动下载之前application("mytime")要自动加60秒，这样靠application("mytime")来精确控制下载时间。

　　4，数据下回来之后，用http.ResponseText来提取数据源信息，由于得到的代码为HTML代码，所以这里采用正则表达式来进行有效数据提取。首先分析ID的分布规律，注意到每一个ID都跟在"bbsqry?name="之后，所以搜索代码采用"bbsqry\?name=(\w*?)"""，由于每一个id要重复两次，所以下面进行VALUE遍历提取的时候Matches.count要标注step 2。用同样类似的方法也把ip提取出来，搜索代码采用">(\d+)\.(\d+)\.(\d+)\.(\d+)"，这里值得一提的是由于需要提取每一个IP段，所以要用到SubMatches，来获取每一个子匹配的值。

　　5，提取完了数据还没完事，由于要求不能出现重复的ID和IP所以我必须想办法去掉重复的，还要保证一一对应，怎么去掉我想了好几种办法，开始想用正则表达式，但考虑到这样循环的次数太多，效率上根本划不来，搞不好还会死机。突然想到编SXNA的时候我把LINK作为数据库的主键索引从而避免了重复LINK的出现，于是这次也打算照葫芦画瓢。首先打开ACCESS建立数据表，把建立一个ID IP IPA段 IPB段 IPC段 IPD段 6列，ID,IP为有索引,无重复列.不建立自动编号列，是因为每一次驱动后都要删除数据,为了保险删除数据之后不压缩数据库,这样编号会无止境增长,况且编号也没用.

　　6,全部入库完成之后数据已经去掉重复的了,现在就要把他们做成txt文件,并以当前的时间作为文本文件的文件名.这里考虑到了单个数字时间的问题,前面要补零(突然想到了数字信号处理里面序列的补零问题-_-),具体这样写right("0"&minute(application("mytime2")),2),文件里面的内容就很简单的把数据库里面的东西用ADODB.Stream写进一个文本文件就可以了,剩下的就是数据库基本操作了.

　　其实思路挺简单的,但是做了3个小时-_-,其中主要把时间耗费在了时间问题上面,对于每一分钟精确存储一个文件的问题我编了好几种实现方案,最终都被我筛掉了,留下了一种最可靠的.
（转载请注明出处：http://www.dc9.cn/post/ASPMathematicalModeling.asp）

　　上面的仅仅是最最基本的思路，就写到这。下面是全部代码。

<title>自动保存/去掉重复ID和IP/准确按时存储/按IP升序(Sipo made for xia)v1</title>

还有多长时间<INPUT TYPE="text" NAME="mytime"
id="mytime" size="60" value="">
<br>
<%
'www.dc9.cn sipo QQ17862153
'这是去掉重复ID，IP版13:15
'如果想按照ID排序就把orderby 改为name
on error resume next
dim nowstr
const TimeInterval=60
'设定时间间隔
'如果下载时间很慢，就写成120秒
Response.LCID=2052
const lResolve=6
'解析域名超时时间,秒
const lConnect=6
'连接站点超时时间,秒
const lSend=6
'发送数据请求超时时间,秒
const lReceive=40
'下载数据超时时间,秒
const myURL="http://bbs.pku.edu.cn/cgi-bin/bbsusr?to=*"
'const myURL="http://localhost/test.htm"
If isempty(application("mytime2")) then
nowstr=now()
application.Lock
application("mytime")=DateToStr(nowstr,"w,d m y H:I:S")
application("mytime2")=nowstr
application.unLock
ElseIf DateDiff("s",application("mytime2"),now)>TimeInterval then
response.write "时间重置"
nowstr=now()
application.Lock
application("mytime")=DateToStr(nowstr,"w,d m y H:I:S")
application("mytime2")=nowstr
application.unLock
Else
If DateDiff("s",application("mytime2"),now)>=TimeInterval then
application.Lock
addstr=DateAdd("s",TimeInterval,application("mytime2"))
application("mytime")=DateToStr(addstr,"w,d m y H:I:S")
application("mytime2")=addstr
application.unLock
End If
End If

Response.write "上次保存时间"&application("mytime2")
Response.write "<br>"
Response.write "下次保存时间"&DateAdd("s",TimeInterval,application("mytime2"))
Response.write "<br>"

Function DateToStr(DateTime,ShowType)
Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
TimeZone1="+0800"
TimeZone2="+08:00"
FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday",
"Friday","Saturday")
shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
Fullmonth=Array("January","February","March","April","May","June","July",
"August","September","October","November","December")
Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep",
"Oct","Nov","Dec")

DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
DateWeek=weekday(DateTime)
DateSecond=Second(DateTime)
If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
If Len(DateDay)<2 Then DateDay="0"&DateDay
If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
Select Case ShowType
Case "Y-m-d"
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
Case "Y-m-d H:I A"
Dim DateAMPM
If DateHour>12 Then
DateHour=DateHour-12
DateAMPM="PM"
Else
DateHour=DateHour
DateAMPM="AM"
End If
If Len(DateHour)<2 Then DateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":
"&DateMinute&" "&DateAMPM
Case "Y-m-d H:I:S"
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":
"&DateMinute&":"&DateSecond
Case "YmdHIS"
DateSecond=Second(DateTime)
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
Case "ym"
DateToStr=Right(Year(DateTime),2)&DateMonth
Case "d"
DateToStr=DateDay
Case "ymd"
DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
Case "mdy"
Dim DayEnd
select Case DateDay
Case 1
DayEnd="st"
Case 2
DayEnd="nd"
Case 3
DayEnd="rd"
Case Else
DayEnd="th"
End Select
DateToStr=Fullmonth(DateMonth-1)&" "&DateDay&DayEnd&"
"&Right(Year(DateTime),4)
Case "w,d m y H:I:S"
DateSecond=Second(DateTime)
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=shortWeekday(DateWeek-1)&","&DateDay&" "& Left
(Fullmonth(DateMonth-1),3) &" "&Right(Year(DateTime),4)&"
"&DateHour&":"&DateMinute&":"&DateSecond&" "&TimeZone1
Case "y-m-dTH:I:S"
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":
"&DateMinute&":"&DateSecond&TimeZone2
Case Else
If Len(DateHour)<2 Then DateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"
"&DateHour&":"&DateMinute
End Select
End Function
%>

<SCRIPT language="JavaScript">
try{
var ti=<%=TimeInterval%>;
var lasttime=new Date("<%=application("mytime")%>");
window.setTimeout("timer()", 0);
function timer() {
var onetime=new Date();
var cha=ti-((onetime-lasttime)/1000)
mytime.value = cha;
if (cha>=0)
{
window.setTimeout("timer()", 1000);
}
else
{
mytime.value = "正在保存~~";
window.location.href="save2.asp"
}}}
catch(e){}
</SCRIPT>
<%
Function GetURL(URL)
'下载主函数
on error resume next
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")
http.setTimeouts lResolve*1000,lConnect*1000,lSend*1000,lReceive*1000
http.Open "GET",URL,False
http.Send

Select Case http.readyState
Case 0
GetURL="对象初始化失败"
Err.Clear
set http=nothing
Exit Function
Case 1
GetURL="域名分析超时/连接站点超时"
Err.Clear
set http=nothing
Exit Function
Case 2
GetURL="发送数据请求超时,是不是服务器出故障了"
Err.Clear
set http=nothing
Exit Function
Case 3
GetURL="数据下载超时/等待反馈时间超时"
Err.Clear
set http=nothing
Exit Function
Case 4
'下载成功
End Select

If http.status<>200 then
GetURL="下载失败"&Err.description
Err.Clear
set http=nothing
Exit Function
END IF
If http.status="200" then
call RegExpHtml2(http.ResponseText)
GetURL=SaveFile()
End If
set http=nothing
End Function

Function RegExpHtml2(Source)
'提取主函数
on error resume next
Set SRegExp=New RegExp
SRegExp.IgnoreCase =True
SRegExp.Global=True
SRegExp.Pattern="bbsqry\?name=(\w*?)"""
'(?:\s*|.*?)*
Set SRegExp2=New RegExp
SRegExp2.IgnoreCase =True
SRegExp2.Global=True
SRegExp2.Pattern=">(\d+)\.(\d+)\.(\d+)\.(\d+)"

Set Matches = SRegExp.Execute(Source)
Set Matches2= SRegExp2.Execute(Source)

set conn=ConnectDB()
conn.execute("DELETE * FROM [xia]")

Set oMatch = Matches(0)
j=0
for i = 0 to Matches.count step 2
Set oMatch = Matches(i)
Set oMatch2 = Matches2(j)
retStrIP=trim(oMatch2.SubMatches(0)&"."&oMatch2.SubMatches(1)
&"."&oMatch2.SubMatches(2)&"."&oMatch2.SubMatches(3))
'以不允许重复索引方式去掉重复的IPID
conn.execute("INSERT INTO [xia]([name],[ip],[ip1],[ip2],[ip3],
[ip4]) VALUES('"&oMatch.SubMatches(0)&"','"&retStrIP&"','"&oMatch2.
SubMatches(0)&"','"&oMatch2.SubMatches(1)&"',
'"&oMatch2.SubMatches(2)&"','"&oMatch2.SubMatches(3)&"')")

j=j+1
next
closedb(conn)

RegExpHtml2= retStr
Set SRegExp=Nothing
End Function

Function SaveFile()
'存储主函数
set conn=ConnectDB()
Set RS=conn.ExeCute("SELECT * FROM [xia] ORDER BY ip")
if RS.EOF or RS.BOF then
ReDim myRows(0,0)
else
myRows=RS.getrows()
end if
RS.close
set RS=nothing
closedb(conn)
retStr=""
for i=0 to ubound(myRows,2)
retStr=retStr&myRows(0,i)&" "&myRows(2,i)&" "&myRows(3,i)&"
"&myRows(4,i)&" "&myRows(5,i)& vbnewline
next
filename=right("0"&hour(application("mytime2")),2)&right
("0"&minute(application("mytime2")),2)&".txt"
'&right("0"&second(now),2)
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Mode = 3
.Open
.Charset = "gb2312"
.Position = objStream.Size
.WriteText=retStr
.SaveToFile Server.MapPath("files\"&filename),2
.Close
End With
Set objStream = NoThing
SaveFile=filename&"保存完毕"
End Function

Function ConnectDB()
err.clear
On error resume next
set conn = Server.CreateObject("ADODB.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=
" & Server.MapPath("xia.mdb")
conn.Open connstr

If Err Then
Response.Write Err.Number & Err.Description
response.end
err.Clear
End If
set ConnectDB=conn
End Function

Function CloseDB(conn)
If IsObject(Conn) Then conn.close : set conn=nothing
End Function
%>
<%=GetURL(myURL)%>
<br>
点击这里下载源文件