'1、輸入url目標網(wǎng)頁地址，返回值getHTTPPage是目標網(wǎng)頁的html代碼 function getHTTPPage(url) dim Http set Http=server.createobject("MSXML2.XMLHTTP" Http.open "GET",url,false Http.send() if Http.readystate>4 then exit function end if getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312" set http=nothing if err.number>0 then err.Clear end function
'2、轉(zhuǎn)換亂瑪，直接用xmlhttp調(diào)用有中文字符的網(wǎng)頁得到的將是亂瑪，可以通過adodb.stream組件進行轉(zhuǎn)換 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
'下面試著調(diào)用http://wmjie.51.net/swords的html內(nèi)容 Dim Url,Html Url="http://wmjie.51.net/swords/" Html = getHTTPPage(Url) Response.write Html %>
' Add a header to give it a file name: Response.AddHeader "Content-Disposition", _ "attachment;filename=mitchell-pres.zip"
' Specify the content type to tell the browser what to do: Response.ContentType = "application/zip"
' Binarywrite the bytes to the browser Response.BinaryWrite xml.responseBody
Set xml = Nothing %>
------------------------------------- 如何寫ASP入庫小偷程序 入庫小偷的原理也很簡單：就是用XMLHTTP遠程讀取網(wǎng)頁的內(nèi)容，然后根據(jù)需要，對讀到的內(nèi)容進行加工（過濾，替換，分類），最后得到自己需要的數(shù)據(jù)，加入到數(shù)據(jù)庫中。 首先：我們先用XMLHTTP讀取遠程網(wǎng)頁（我的另一片文章中有介紹）。 其次：對內(nèi)容進行過濾，這個是比較關(guān)鍵的步驟，比如說，我要從遠程網(wǎng)頁上提取出所有url連接，我應(yīng)該怎么做呢？ 代碼: ‘這里用的是正則式 Set objRegExp = New Regexp '建立對象 objRegExp.IgnoreCase = True '大小寫忽略 objRegExp.Global = True '全局為真 objRegExp.Pattern = "http://.+?" '匹配字段 set mm=objRegExp.Execute(str) '執(zhí)行查找，str為輸入?yún)?shù) For Each Match in mm '進入循環(huán) Response.write(Match.Value） '輸出url地址 next
然后，我們需要根據(jù)需要做一些替換功能，把不必要的數(shù)據(jù)替換掉，這個比較簡單，用Replace函數(shù)即可。 最后，進行數(shù)據(jù)庫操作 ------------------------------- 一個例子 代碼: % On Error Resume Next Server.ScriptTimeOut=9999999 Function getHTTPPage(Path) t = GetBody(Path) getHTTPPage=BytesToBstr(t,"GB2312" End function
Function GetBody(url) on error resume next Set Retrieval = CreateObject("Microsoft.XMLHTTP" With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBody End With Set Retrieval = Nothing End Function
'然后調(diào)用XMLHTTP組件創(chuàng)建一個對象并進行初始化設(shè)置。
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
body = replace(body,"skin1","天氣預(yù)報 - 斯克網(wǎng)絡(luò)") body = replace(body,"http://appnews.qq.com/cgi-bin/news_qq_search?city","tianqi.asp?id")
'本程序中已經(jīng)完成了替換的工作，如果有其他需要的話可以繼續(xù)進行類似的替換操作。
response.write body 引用: 遠程獲取內(nèi)容，并將內(nèi)容存在本地電腦上，包括任何文件
% '----------遠程獲取內(nèi)容，并將內(nèi)容存在本地電腦上，包括任何文件！---------- 'On Error Resume Next 'Set the content type to the specific type that you are sending. 'Response.ContentType = "IMAGE/JPEG" '-------------------------------定義輸出格式-----------------------------
Path=request.querystring("p") sPath = Path if left(lcase(path),7) > "http://"; then '-------------如果前面沒有http就是本地文件，交給LocalFile處理------------ LocalFile(path) else '--------------------否則為遠程文件，交給RemoteFile處理------------------ RemoteFile(Path) end if 'Response.Write err.Description
sub LocalFile(Path) '-------------------如果為本地文件則簡單的跳轉(zhuǎn)到該頁面------------------- Response.Redirect Path End Sub
Sub RemoteFile(sPath) '-------------------------處理遠程文件函數(shù)------------------------------ FileName = GetFileName(sPath) '-------------GetFileName為把地址轉(zhuǎn)換為合格的文件名過程------------- FileName = Server.MapPath("/UploadFile/Cache/" FileName) Set objFso = Server.CreateObject("Scripting.FileSystemObject") 'Response.Write fileName if objFso.FileExists(FileName) Then '--------------檢查文件是否是已經(jīng)訪問過,如是，則簡單跳轉(zhuǎn)------------ Response.Redirect "/uploadfile/cache/" GetFileName(path) Else '----------------否則的話就先用GetBody函數(shù)讀取---------------------- 'Response.Write Path t = GetBody(Path) '-----------------用二進制方法寫到瀏覽器上-------------------------- Response.BinaryWrite t Response.Flush '-----------------輸出緩沖------------------------------------------ SaveFile t,GetFileName(path) '------------------將文件內(nèi)容緩存到本地路徑，以待下次訪問----------- End if Set objFso = Nothing End Sub
Function GetBody(url) '-----------------------本函數(shù)為遠程獲取內(nèi)容的函數(shù)--------------------- 'on error resume next 'Response.Write url Set Retrieval = CreateObject("Microsoft.XMLHTTP") '----------------------建立XMLHTTP對象----------------------------- With Retrieval .Open "Get", url, False, "", "" '------------------用Get，異步的方法發(fā)送----------------------- .Send 'GetBody = .ResponseText GetBody = .ResponseBody '------------------函數(shù)返回獲取的內(nèi)容-------------------------- End With Set Retrieval = Nothing 'response.Write err.Description End Function
Function GetFileName(str) '-------------------------本函數(shù)為合格化的文件名函數(shù)------------------- str = Replace(lcase(str),"http://";,"") str = Replace(lcase(str),"http://","/") str = Replace(str,"/","") str = replace(str,vbcrlf,"") GetFileName = str End Function
sub SaveFile(str,fName) '-------------------------本函數(shù)為將流內(nèi)容存盤的函數(shù)------------------- 'on error resume next Set objStream = Server.CreateObject("ADODB.Stream") '--------------建立ADODB.Stream對象，必須要ADO 2.5以上版本--------- objStream.Type = adTypeBinary '-------------以二進制模式打開------------------------------------- objStream.Open objstream.write str '--------------------將字符串內(nèi)容寫入緩沖-------------------------- 'response.Write fname objstream.SaveToFile "c:\inetpub\myweb\uploadfile\cache\" fName,adSaveCreateOverWrite '--------------------將緩沖的內(nèi)容寫入文件-------------------------- 'response.BinaryWrite objstream.Read objstream.Close() set objstream = nothing '-----------------------關(guān)閉對象，釋放資源------------------------- 'response.Write err.Description End sub %>
