曾编了一个程序,应用于数学建模的数据提取阶段。现归纳如下,思路写得比较详细,看起来像教程-_-。
目的是做一个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