Programming idea of ASP for collection program

This article describes how to program the ASP collection program. First, we will introduce several well-designed functions.
'The replacement has been completed in this program. If there are other requirements, you can continue with similar replacement operations.
'================================================ ========
'The functions of generating local files in a collection database
'--------------------------------------------------------------------------------
'*************************************** **************************
'Function
'Role: save files using streams
'Parameter: from (Remote File address), tofile (save file location)
'*************************************** **************************
Private Function SaveFiles (byref from, byref tofile)
Dim Datas
Datas = GetData (from, 0)
Response. Write "saved successfully: <font color = red>" & formatnumber (len (Datas)/1024*2, 2) & "</font> Kb"
Response. Flush
If formatnumber (len (Datas)/1024 *)> 1 then
ADOS. Type = 1
ADOS. Mode = 3
ADOS. Open
ADOS. write Datas
ADOS. SaveToFile server. mappath (tofile), 2
ADOS. Close ()
Else
Response. Write "failed to save: <font color = red> file size" & formatnumber (len (imgs)/1024*2, 2) & "Kb, less than 1 K </font>"
Response. Flush
End if
End function

'*************************************** **************************
'Function (private)
'Purpose: Use fso to check whether a file exists. If yes, true is returned. If no, false is returned.
'Parameter: filespes (file location)
'*************************************** **************************
Private Function IsExists (byref filespec)
If (FSO. FileExists (server. MapPath (filespec) Then
IsExists = True
Else
IsExists = False
End If
End Function
'*************************************** **************************
'Function (private)
'Purpose: Use fso to check whether a folder exists. If yes, true is returned. If no folder exists, false is returned.
'Parameter: folder (folder location)
'*************************************** **************************
Private Function IsFolder (byref Folder)
If FSO. FolderExists (server. MapPath (Folder) Then
IsFolder = True
Else
IsFolder = False
End If
End Function

'*************************************** **************************
'Function (private)
'Purpose: Use fso to create a folder
'Parameter: fldr (Folder location)
'*************************************** **************************
Private Function CreateFolder (byref fldr)
Dim f
Set f = FSO. CreateFolder (Server. MapPath (fldr ))
CreateFolder = f. Path
Set f = nothing
End Function

'*************************************** **************************
'Function (public)
'Purpose: Save the file and automatically create a multi-level folder
'Parameter: fromurl (Remote File address), tofiles (storage location)
'*************************************** **************************
Public Function SaveData (byref FromUrl, byref ToFiles)
ToFiles = trim (Replace (ToFiles ,"//","/"))
FlName = ToFiles
Fldr = ""
If IsExists (flName) = false then
GetNewsFold = split (flName ,"/")
For I = 0 to Ubound (GetNewsFold)-1
If fldr = "" then
Fldr = GetNewsFold (I)
Else
Fldr = fldr & "& GetNewsFold (I)
End if
If IsFolder (fldr) = false then
CreateFolder fldr
End if
Next
SaveFiles FromUrl, flName
End if
End function
'*************************************** **************************
'Function (public)
'Role: obtain remote data
'Parameter: url (Remote File address), getmode (Mode: 0 is binary, 1 is Chinese encoding)

'*************************************** **************************
Public Function GetData (byref url, byref GetMode)
'On error resume next
SourceCode = OXML. open ("GET", url, false)
OXML. send ()
If OXML. readystate <> 4 then exit function
If GetMode = 0 then
GetData = OXML. responseBody
Else
GetData = BytesToBstr (OXML. responseBody)
End if
If err. number <> 0 then err. Clear
End Function

'*************************************** **************************
'Function (public)
'Purpose: format the remote image address as the local location
'Parameter: imgurl (Remote Image address), imgfolder (local image directory), and fristname (prefix name)
'*************************************** **************************
Public Function FormatImgPath (byref ImgUrl, byref ImgFolder, byref FristName, byref noimg)
Strpath = ""
ImgUrl = ImgUrl
If instr (ImgUrl, "Nophoto") or lenb (GetData (ImgUrl, 0) <= 0 then
Strpath = noimg
Response. Write "<a href =" & strpath & ">" & strpath & "</a>" & VBcrlf
Else
If Instr (ImgUrl, ". ASP") then
Strpath = FristName & "_" & Mid (ImgUrl, faster Rev (ImgUrl, "=") 1) & ". jpg"
Else
Strpath = FristName & "_" & Mid (ImgUrl, limit Rev (ImgUrl, "/") 1)
End if
Strpath = ImgFolder & "/" & strpath
Strpath = Replace (strpath ,"//","/")
If left (strpath, 1) = "/" then strpath = right (strpath, len (strpath)-1)
Strpath = trim (strpath)
Response. Write "<a href =" & strpath & ">" & strpath & "</a>" & vbcrlf
Savedata ImgUrl, strpath
End if
FormatImgPath = strpath
End function
%>


Now we will introduce several methods for classification.

The principle of warehouse receiving thieves is also very simple: XMLHTTP is used to remotely read the content of a webpage, and then process (filter, replace, and classify) the content as needed ), finally, get the data you need and add it to the database.
First, read the remote Webpage Through XMLHTTP (introduced in another article ).
Secondly, it is a key step to filter the content. For example, what should I do if I want to extract all url connections from a remote webpage?
Code:
'The regular expression is used here.
Set objRegExp = New Regexp 'create an object
ObjRegExp. IgnoreCase = True 'case insensitive
ObjRegExp. Global = true' Global True
ObjRegExp. Pattern = "http ://.? "'Matching Field
Set mm = objRegExp. Execute (str) 'to perform the search. str is the input parameter.
For Each Match in mm' enters the loop
Response. write (Match. Value) 'output url address
Next


Then, we need to make some replacement functions as needed to Replace unnecessary data. This is relatively simple, just use the Replace function.
Finally, perform database operations
-------------------------------
Example
Code:
<%
On Error Resume Next
Server. ScriptTimeOut = 9999999
Function getHTTPPage (Path)
T = GetBody (Path)
GetHTTPPage = BytesToBstr (t, "GB2312 ")
End function

'First, perform initialization settings for the thief program. The above code is used to ignore all non-fatal errors, set the time-out period of the thief program to a long time (so there will be no running time-out error), convert the original default UTF-8 encoding to GB2312 encoding, otherwise, it is garbled to call a webpage with Chinese characters directly using the XMLHTTP component.

Function GetBody (url)
On error resume next
Set Retrieval = CreateObject ("Microsoft. XMLHTTP ")
With Retrieval
. Open "Get", url, False ,"",""
. Send
GetBody =. ResponseBody
End
Set Retrieval = Nothing
End Function

'Then call the XMLHTTP component to create an object and perform initialization settings.

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 Newstring (wstr, strng)
Newstring = Instr (lcase (wstr), lcase (strng ))
If Newstring <= 0 then Newstring = Len (wstr)
End Function

'To process the captured data, you need to call the adodb. stream component and perform initialization settings. %>

'Below is the page Display Section

<%
Dim wstr, str, url, start, over, city
'Defines the variables to be used.

City = Request. QueryString ("id ")
'The ID variable returned by the Program (that is, the selected city) is assigned to the id

Url = "http://appnews.qq.com/cgi-bin/news_qq_sea... amp; city &"
'Set the page address to be crawled here. Of course, you can also directly specify an address without using variables.
Wstr = getHTTPPage (url)
'Retrieve all data on the specified page

Start = Newstring (wstr, "'Set the header of the data to be processed. This variable should be set according to different situations. The specific content can be determined by viewing the source code of the page to be crawled. Because we need to capture the whole page in this program, we set it to capture all the pages. Note: The set content must be unique and cannot be repeated.

Over = Newstring (wstr, "</HTML> ")
'Corresponds to the end of the data to be processed. Similarly, the set content must be unique on the page.

Body = mid (wstr