非常不错的flash采集程序测试通过 复制代码 代码如下:<% '-------------------------------------------------------------- Dbname = "../data/flash.mdb" '更改数据库文件位置，强烈建议更改为.asp的文件！ Set Conn = Server.CreateObject("ADODB.Connection") Connstr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.Mappath(Dbname) Conn.Open Connstr '------------------------------------------------------------ Set List = Conn.Execute("Select * From System") WebName = List("WebName") WebUrl = List("WebUrl") webemail = List("webemail") zzname = List("zzname") qq = List("webqq") %>复制代码 代码如下:<% if request("id") and request("overid") and request("download") <>"" then response.redirect "getid.asp?id="&request("id")&"&overid="&request("overid")&"&download="&request("download") else %>

开始采集的专辑ID号： 结束ID： 是否将数据下载到本地： 是 否
<%end if%>复制代码 代码如下: <% Server.ScriptTimeOut=999999999 %> <% if request("overid")="" then response.write "结束ID不可为空" response.end elseif request("download")="" then response.write "请选择是否下载" response.end end if if request("id")=request("overid") then response.write "采集任务结束" response.end end if gourl1=request("id") gourl1=gourl1+1 %> <% function GetPy(Str) for i=1 to len(Str) GetPy=GetPy&GetPyChar(mid(Str,i,1)) next end function Function GetURL(url) Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "GET", url, False .Send GetURL = bytes2bstr(.responsebody) if len(.responsebody)<100 then response.write "获取远程文件 "&url&" 失败。" response.write"" response.end end if End With Set Retrieval = Nothing End Function function bytes2bstr(vin) strreturn = "" for i = 1 to lenb(vin) thischarcode = ascb(midb(vin,i,1)) if thischarcode < &h80 then strreturn = strreturn & chr(thischarcode) else nextcharcode = ascb(midb(vin,i+1,1)) strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode)) i = i + 1 end if next bytes2bstr = strreturn end function Function GetKey(HTML,Start,Last) filearray=split(HTML,Start) filearray2=split(filearray(1),Last) GetKey=filearray2(0) End Function '------------------------------------ Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl) Dim Ads, Retrieval, GetRemoteData Dim bError bError = False SaveRemoteFile = False On Error Resume Next Set Retrieval = Server.CreateObject("Msxml2.ServerXMLHTTP") With Retrieval .Open "GET", s_RemoteFileUrl, False .Send If .Status = 200 Then GetRemoteData = .ResponseBody Else bError = True End If End With Set Retrieval = Nothing If Not bError Then Set Ads = Server.CreateObject("Adodb.Stream") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(s_LocalFileName), 2 .Cancel() .Close() End With Set Ads=nothing End If If Err.Number = 0 And Not bError Then SaveRemoteFile = True Else Err.Clear End If End Function %> <% flashId=Request("Id") Url="http://www.gameyes.com/swf/"&flashid&".htm" Html = GetURL(Url) num=len(html) if num<600 then response.write "此页不存在，跳转下一个........" response.end end if nclassid1=GetKey(Html,"FLASH游戏 >> ") nclass=GetKey(Html,"","") nclass=nclass&"类" classid1=GetKey(Html,"class=a href='../list/",".htm'>") classname=GetKey(Html,"class=a href='../list/"&classid1&".htm'>","") body=GetKey(Html,"
","
") body=replace(body,"","") body=replace(body,"","") pic1=GetKey(Html,"#secrt{background:url(../smallpic",") 2 2 no-repeat;border:1px") pic1=replace(pic1,"_b.gif",".gif") pic1=replace(pic1,"_b.jpg",".jpg") pic="http://www.gameyes.com/smallpic"&pic1 pictype=right(pic,4) flashurl=GetKey(Html,"download.asp?id="&flashid&"&swf=",""">","小游戏 休闲小游戏网 gameyes.com") %> <% response.write "FLASH名称: "&flashname response.write "
" response.write "所属大类: "&nclass response.write "
" response.write "所属二类: "&classname response.write "
" response.write "游戏介绍: "&body response.write "
" response.write "游戏小图: "&pic response.write "
" response.write "FLASH地址: "&flashurl response.write "
" if request("download")="yes" then response.write"开始下载FLASH
" response.flush result = SaveRemoteFile("../flashfile/"&request("id")&".swf",""&flashurl&"") If result Then Response.Write "FLASH下载成功——保存在flashfile/"&request("id")&".swf
" Else Response.Write "FLASH保存失败
" End If end if %> <% if request("download")="yes" then response.write"开始下载FLASH图片
" response.flush result = SaveRemoteFile("../flashpic/"&request("id")&pictype&"",""&pic&"") If result Then Response.Write "FLASH图片下载成功——保存在flashpic/"&request("id")&pictype&"" Else Response.Write "FLASH图片保存失败
" response.write "此FLASH采集完毕，继续采集下一个
" End If end if %> <% DBPath = Server.MapPath("../data/flash.mdb") set Conn=server.createobject("adodb.connection") '程序制作:cnwlg 联系方式qq:276496487 email:cnwlg@163.com conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath %> <% set rs=server.CreateObject("ADODB.RecordSet") Sql="Select * From class Where name='"&nclass&"'" Rs.Open Sql,Conn,1,3 If Rs.Eof And Rs.Bof Then Rs.AddNew End If rs("name")=nclass rs("classid")="0" Rs.Update Rs.Close Set Rs = Nothing Set rsc = Conn.Execute("select * from class where name='"&nclass&"'") nclassid=rsc("id") rsc.close set rsc=nothing '处理FLASH的二级类别,如数据库中没有该类别，则增加 set rst=server.CreateObject("ADODB.RecordSet") Sql="Select * From class Where name='"&classname&"'" Rst.Open Sql,Conn,1,3 If Rst.Eof And Rst.Bof Then Rst.AddNew End If rst("name")=classname rst("classid")=nclassid Rst.Update '程序制作:cnwlg 联系方式qq:276496487 email:cnwlg@163.com Rst.Close Set Rst = Nothing '取类别的ID号 Set rsc = Conn.Execute("select * from class where name='"&classname&"'") classid=rsc("id") rsc.close set rsc=nothing '=================================================== '可以开始写入flash set rs=server.CreateObject("ADODB.RecordSet") Sql="Select * From flash Where flashname='"&flashname&"' and flashurl='"&flashurl&"'" Rs.Open Sql,Conn,1,3 If Rs.Eof And Rs.Bof Then Rs.AddNew End If rs("flashname")=flashname if request("download")="yes" then rs("flashurl")="../flashfile/"&request("id")&".swf" else rs("flashurl")=flashurl end if rs("nclass")=NClassID rs("classid")=classid rs("classname")=classname if request("download")="yes" then '程序制作:cnwlg 联系方式qq:276496487 email:cnwlg@163.com rs("pic")="../flashpic/"&request("id")&pictype else rs("pic")=pic end if rs("size")="500kb" rs("sj")=now() rs("body")=body rs("tj")="no" rs("hot")="1" rs("user")="admin" rs("zz")="未知" rs("geshou")="不祥" Rs.Update '程序制作:cnwlg 联系方式qq:276496487 email:cnwlg@163.com Rs.Close Set Rs = Nothing conn.close set conn=nothing %> <% dim gourl gourl=flashid+1 response.write"" %>