非常不错的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 
%> 
<body> 
<P>&nbsp;</P> 
<form name="form1" method="get" action="getid.asp"> 
  开始采集的专辑ID号：  
  <input name="id" type="text" id="id" size="10"> 
  结束ID：  
  <input name="overid" type="text" id="overid" size="10"> 
  是否将数据下载到本地： 是 
<input type="radio" name="download" value="yes"> 
  否 
  <input name="download" type="radio" value="no" checked> 
  <input type="submit" name="Submit" value="提交"> 
</form> 
</body> 
</html> 
<%end if%>

复制代码代码如下:

<!-- #include File="Conn.asp" --> 
<% 
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 "获取远程文件 <a href="&url&" target=_blank>"&url&"</a> 失败。" 
response.write"<meta http-equiv=""refresh"" content=""0;URL=getid.asp?id="&gourl1&""">" 
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 "此页不存在，跳转下一个........<meta http-equiv=""refresh"" content=""0;URL=getid.asp?id="&gourl1&"&overid="&request("overid")&"&download="&request("download")&""">" 

response.end 

end if 

nclassid1=GetKey(Html,"FLASH游戏 >> <a class=a href=../list/a_",".htm>") 

nclass=GetKey(Html,"<a class=a href=../list/a_"&nclassid1&".htm>","</a>") 

nclass=nclass&"类" 

classid1=GetKey(Html,"class=a href='../list/",".htm'>") 

classname=GetKey(Html,"class=a href='../list/"&classid1&".htm'>","</a>") 

body=GetKey(Html,"<div id=""view_intro"">","</div>") 

body=replace(body,"<tr>","") 

body=replace(body,"<td>","") 

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=","""><img src=") 

flashurl=replace(flashurl,"http://old.gameyes.com/flash","http://60.191.9.222/flash") 

flashurl="http://old.gameyes.com/flash"&flashurl 

flashname=GetKey(Html,"<title>","小游戏 休闲小游戏网 gameyes.com</title>") 

%> 
<% 
response.write "<font color=red>FLASH名称:</font>&nbsp;&nbsp;"&flashname 
response.write "<br>" 
response.write "<font color=red>所属大类:</font>&nbsp;&nbsp;"&nclass 
response.write "<br>" 
response.write "<font color=red>所属二类:</font>&nbsp;&nbsp;"&classname 
response.write "<br>" 
response.write "<font color=red>游戏介绍:</font>&nbsp;&nbsp;"&body 
response.write "<br>" 
response.write "<font color=red>游戏小图:</font>&nbsp;&nbsp;"&pic 
response.write "<br>" 
response.write "<font color=red>FLASH地址:</font>&nbsp;&nbsp;"&flashurl 
response.write "<br>" 
if request("download")="yes" then 
response.write"开始下载FLASH<br>" 
response.flush 
result = SaveRemoteFile("../flashfile/"&request("id")&".swf",""&flashurl&"") 

If result Then 
    Response.Write "<b>FLASH下载成功——保存在<a href=../flashfile/"&request("id")&".swf target=_blank>flashfile/"&request("id")&".swf</a><br>" 
Else 
    Response.Write "<b>FLASH保存失败</b><br>" 
End If 
end if 
%> 



<% 
if request("download")="yes" then 
response.write"开始下载FLASH图片<br>" 
response.flush 
result = SaveRemoteFile("../flashpic/"&request("id")&pictype&"",""&pic&"") 

If result Then 
    Response.Write "<b>FLASH图片下载成功——保存在<a href=../flashpic/"&request("id")&pictype&" target=_blank>flashpic/"&request("id")&pictype&"</a>" 

Else 
    Response.Write "<b>FLASH图片保存失败</b><br>" 
response.write "此FLASH采集完毕，继续采集下一个<br><hr>" 
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"<meta http-equiv=""refresh"" content=""0;URL=getid.asp?id="&gourl&"&overid="&request("overid")&"&download="&request("download")&""">" 
%> 