<% server.scripttimeout=90000 function getstr(s,s1,s2) a = instr(s,s1) b = instr(a+len(s1),s,s2) getstr = mid(s,a+len(s1),b-a-len(s1)) end function Private Function bytes2BSTR(vIn) Dim i, ThischrCode, NextchrCode strReturn = "" For i = 1 To LenB(vIn) ThischrCode = AscB(MidB(vIn, i, 1)) If ThischrCode < &H80 Then strReturn = strReturn & Chr(ThischrCode) Else NextchrCode = AscB(MidB(vIn, i + 1, 1)) strReturn = strReturn & Chr(CLng(ThischrCode) * &H100 + CInt(NextchrCode)) i = i + 1 End If Next bytes2BSTR = strReturn End Function Function GetURL(url) Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "GET", url, False, "", "" .Send GetURL = .ResponseText GetURL = bytes2BSTR(.Responsebody) End With Set Retrieval = Nothing End Function Function GetURL1(url) Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "GET", url, False, "", "" .Send GetURL1 = .ResponseBody End With Set Retrieval = Nothing End Function function savefile(http,localpath) Set mstream = Server.CreateObject("ADODB.Stream") mstream.Type = 1 mstream.Open '获取图片内容 mstream.Write geturl1(http) '保存文件 mstream.SaveToFile server.mappath(localpath),2 Set mstream=nothing end function i=request("i") if i-9700 > 0 then response.end end if returnvalue=lcase(geturl("http://www.flash8.net/flash.aspx?id="&i)) if instr(returnvalue,lcase(".swf"))<>0 then '有记录 '抓取地址 swfst = "" fileet = "
" filests = getstr(returnvalue,filest,fileet) '抓取作者 userst = "" user = getstr(returnvalue,userst,useret) response.write httpf 'response.end '插入数据库 'conn.execute "insert into flash(Name,StarNO,Writer,FileUrl)values('"&replace(filests,"'","`")&"','★★★★★','"&replace(user,"'","`")&"','" & httpf&"')" 'set rs=server.createobject("adodb.recordset") 'rs.open "select top 1 FID from Flash order by fid desc",conn,1,1 'fid=rs(0) 'rs.close '下载Flash call savefile(httpf,"../swf/"&i&".swf") end if%>