Recently it is too popular collection, I do not like to collect, but the principle of collection I am very interested in research, got the online collection of commonly used functions, on its research, and actual combat, the results of success, regardless of efficiency problems, the principle of acquisition is not complex, we can search the bar input "acquisition" view its principle. Here is an example of a collection:
Copy Code code as follows:
<% @LANGUAGE = "VBSCRIPT" codepage= "65001"%>
<% response.codepage=65001%>
<% response.charset= "UTF-8"%>
<%server.scripttimeout=9999999
Response.Expires = 0
Response.ExpiresAbsolute = Now ()-1
Response.AddHeader "Pragma", "No-cache"
Response.AddHeader "Cache-control", "private"
Response.CacheControl = "No-cache"
%>
<%
' Declares a function that obtains the target information, which is implemented through an XML component.
Function GetURL (URL)
Set retrieval = Server.CreateObject ("MSXML2. XMLHTTP ")
With retrieval
. Open ' get ', url, False
. Send
If. Status<>200 Then ' judge if the document has been parsed to make the client accept the return message
Exit function
End If
' Binary spin string
GetURL = STb (. responsebody)
End With
' Verify the acquisition information, if the information length is less than 100, the interception failed
End Function
' Binary turn string, otherwise there will be garbled!
Function STb (VIN)
Const adTypeText = 2
Dim Bytesstream,stringreturn
Set Bytesstream = Server.CreateObject ("ADODB. Stream ")
With Bytesstream
. Type = adTypeText
. Open
. WRITETEXT Vin
. Position = 0
. Charset = "GB2312"
. Position = 2
Stringreturn =. ReadText
. Close
End With
Set Bytesstream = Nothing
STb = Stringreturn
End Function
Function newstring (WSTR,STRNG)
Newstring=instr (Lcase (WSTR), Lcase (STRNG))
If newstring<=0 Then Newstring=len (WSTR)
End Function
' Declaration of the interception format, from start to intercept, to over to end
Function Getkey (Html,start,over)
Start=newstring (Html,start)
Over=newstring (Html,over)
Getkey=mid (Html,start,over-start)
End Function
Dim Softid,url,html,title
' Collect Baidu to know
For i = 1 to 100
Url= "http://zhidao.baidu.com/question/10000" &i& ". html"
Html = GetURL (URL)
Question = Getkey (Html, "<cq>", "</cq>")
Answer = Getkey (Html, "<ca>", "</ca>")
Response.Write (question& "<br/>")
Response.Write (Answer)
Response.Write ("Acquisition Success")
Next
' Open database, prepare for storage
' Dim connstr,conn,rs,sql
' Connstr= ' dbq= +server.mappath ("Db1.mdb") + ";D efaultdir=;D river={microsoft Access DRIVER (*.mdb)};"
' Set Conn=server.createobject (' ADODB. CONNECTION ")
' Conn.Open ConnStr
' Set Rs=server.createobject (' Adodb.recordset ')
' sql= ' SELECT [column name] from [table name] where [column name]= ' &Title& ']
' Rs.Open sql,conn,3,3
' If rs.eof and Rs.bof then
' RS (' column name ') =title
' Rs.update
' Set rs=nothing
' End If
' Set rs=nothing
%>
