<%
'--------------------------------------------------------------
dbname = ".. /data/flash.mdb "' Change the location of the database file, strongly recommends that you change to an. asp file!
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")
%>
<%
server.scripttimeout=999999999
%>
<%
If Request ("Overid") = "" Then
Response.Write "End ID cannot be empty"
Response.End
ElseIf request ("download") = "" Then
Response.Write "Please choose whether to download"
Response.End
End If
If request ("id") =request ("Overid") Then
Response.Write "Collection mission over."
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 "Get remote file <a href=" &url& "target=_blank>" &url& "</a> failed. "
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 = 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 "<font color=red>flash serial number:</font>" &GOURL1
Response.Write "This page does not exist, jump next ... <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 game >> <a class=a href= ... /list/a_ "," .htm> ") '
Nclass=getkey (Html, "<a class=a href=. /list/a_ "&nclassid1&" .htm> "," </a> ")
nclass=nclass& "Class"
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=", "" ">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>", "small game leisure Games net gameyes.com</title>")
%>
<%
Response.Write "<font color=red>flash serial number:</font>" &GOURL1
Response.Write "<br>"
Response.Write "<font color=red>flash name:</font>" &flashname
Response.Write "<br>"
Response.Write "<font color=red> belong to Big class:</font>" &nclass
Response.Write "<br>"
Response.Write "<font color=red> belongs to class two:</font>" &classname
Response.Write "<br>"
Response.Write "<font color=red> Game Introduction:</font>" &body
Response.Write "<br>"
Response.Write "<font color=red> game Small map:</font>" &pic
Response.Write "<br>"
Response.Write "<font Color=red>flash address:</font>" &flashurl
Response.Write "<br>"
%>
<%
If Request ("download") = "yes" then
Response.Write "Start downloading flash<br>"
Response.Flush
result = Saveremotefile (".. /flashfile/"&request" ("id") & ". SwF", "&flashurl&" ")
If result Then
Response.Write "<b>flash Download successful-save in <a href=. /flashfile/"&request (" id ") &". swf target=_blank>flashfile/"&request (" id ") &" .swf</a>< " Br> "
Else
Response.Write "<b>flash Save failed </b><br>"
End If
End If
If Request ("download") = "yes" then
Response.Write "Start downloading Flash pictures <br>"
Response.Flush
result = Saveremotefile (".. /flashpic/"&request" ("id") &pictype& "", "&pic&" ")
If result Then
Response.Write "<b>flash Picture Download successful-save in <a href= ... /flashpic/"&request (" id ") &pictype&" target=_blank>flashpic/"&request (" id ") &pictype&" </a> "
Else
Response.Write "<b>flash picture save failed </b><br>"
Response.Write "This Flash collection is complete, continue to collect next <br>End If
End If
%>
<%
DBPath = Server.MapPath (".. /data/flash.mdb ")
Set Conn=server.createobject ("Adodb.connection")
Conn. Open "Driver={microsoft Access driver (*.mdb)};d bq=" & 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
' Two-level category for handling flash, if the category is not in the database, increase
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
Rst.close
Set Rst = Nothing
' Take the ID number of the category
Set RSC = Conn.execute ("SELECT * from class where name= '" "&classname&")
CLASSID=RSC ("id")
Rsc.close
Set rsc=nothing
'===================================================
' can begin writing to 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
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") = "Unknown"
RS ("Geshou") = "ominous"
Rs.update
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 ") &" ">"
%>
