Copy codeThe Code is as follows: <%
DJ54_path = "data/data. mdb" 'database address
Set conn = Server. CreateObject ("ADODB. Connection ")
Connstr = "Provider = Microsoft. Jet. OLEDB.4.0; Data Source =" & Server. MapPath (DJ54_path)
Conn. Open connstr
Function GetHttpPage (HttpUrl)
If IsNull (HttpUrl) = True Or HttpUrl = "$ False $" Then
GetHttpPage = "$ False $"
Exit Function
End If
Dim Http
Set Http = server. createobject ("MSXML2.XMLHTTP ")
Http. open "GET", HttpUrl, False
Http. Send ()
If Http. Readystate <> 4 then
Set Http = Nothing
GetHttpPage = "$ False $"
Exit function
End if
GetHTTPPage = bytesToBSTR (Http. responseBody, "GB2312 ")
Set Http = Nothing
If Err. number <> 0 then
Err. Clear
End If
End Function
Function BytesToBstr (Body, Cset)
Dim Objstream
Set Objstream = Server. CreateObject ("adodb. stream ")
Objstream. Type = 1
Objstream. Mode = 3
Objstream. Open
Objstream. Write body
Objstream. Position = 0
Objstream. Type = 2
Objstream. Charset = Cset
BytesToBstr = objstream. ReadText
Objstream. Close
Set objstream = nothing
End Function
Function mymid (byval A_strString, byval A_strPattern)
Dim MM_objRegexp
Dim MM_strExecute
Set MM_objRegexp = new regexp
With MM_objRegexp
. Pattern = A_strPattern
. IgnoreCase = True
. Global = false
Set MM_strExecute =. Execute (A_strString)
If MM_strExecute.count <> 0 then
Mymid = MM_strExecute (0). SubMatches (0)
End if
End
Mymid = trim (mymid)
Set MM_objRegexp = nothing
End function
Function RegListGet (str, patrn, mysky)
Set tempReg = new RegExp
TempReg. IgnoreCase = false
TempReg. Global = true
TempReg. Pattern = patrn
Set matches=tempReg.exe cute (str)
For each match in matches
Content = content & match. value & mysky
Next
RegListGet = content
Set matches = nothing
Set tempReg = nothing
End Function
DJ54_SF = GetHttpPage ("http://www.haosf.com /")
DJ54_SF = replace (DJ54_SF, vbcrlf ,"")
DJ54_SF = replace (DJ54_SF, chr (10 ),"")
DJ54_SF = trim (mymid (DJ54_SF, "zjkf. asp" & chr (34) & "> </script> (. ++ ?) <Script language = javascript src = "& chr (34) &" txtj2.asp "& chr (34) &"> "))
DJ54_SF = RegListGet (DJ54_SF, "<script> o (. ++ ?) </Script> "," BT54 ")
DJ54_SF = replace (DJ54_SF ,"\","")
DJ54_BT54_SF = split (DJ54_SF, "BT54 ")
Response. write "collection successful total collection day" & Ubound (DJ54_BT54_SF)-1 & "SF <br/>"
Set rs = server. createobject ("adodb. recordset ")
SQL = "select * from sfdata"
Rs. open SQL, conn, 1, 3
For I = 1 to Ubound (DJ54_BT54_SF)-1
SF = mid (DJ54_BT54_SF (I), instr (DJ54_BT54_SF (I), "" & chr (34) & "") + 1, len (DJ54_BT54_SF (I)-48)
DJ54_BT54_RSF = split (SF, "" & chr (34) & "," & chr (34 )&"")
If len (DJ54_BT54_RSF (2) <16 then
Rs. addnew
SFtime = trim (mymid (DJ54_BT54_RSF (3), "Day/(. + ?) Point "))
SFtime = replace (SFtime, "Day /","")
SFtime = replace (SFtime, "point ","")
Rs ("name") = DJ54_BT54_RSF (1) 'name
Rs ("ip") = DJ54_BT54_RSF (2) 'IP
Rs ("sdate") = year (date) & "-" & month (date) & "-" & day (date) & "& SFtime &": 00: 00"
Rs ("Xingzhi") = DJ54_BT54_RSF (5 )'
Rs ("email") = DJ54_BT54_RSF (6) 'qq
Rs ("homepage") = DJ54_BT54_RSF (0 )'
Rs ("addtime") = now ()
Rs ("gameid") = 28
Rs ("Ulock") = 1
Rs ("service") = 2
Rs ("addr") = DJ54_BT54_RSF (4)
End if
Response. write DJ54_BT54_RSF (1) & "warehouse receiving successful! <Br/>"
Next
Response. write "all warehouse receiving is completed"
%>