<%
function getHTTPPage(url)
dim Http
set Http=server.createobject("Msxml2.ServerXMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"gbk")
set http=nothing
if err.number<>0 then err.Clear
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 GetKey(HTML,Start,Last)
filearray=split(HTML,Start)
If ubound(filearray)<1 then
GetKey="点击购买"
else
filearray2=split(filearray(1),Last)
GetKey=filearray2(0)
End if
End Function
Function RemoveHTML(strHTML)
Dim objRegEXP, Match, Matches
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取闭合的<>
objRegExp.Pattern = "<.+?>"
'进行匹配
Set Matches = objRegExp.Execute(strHTML)
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
RemoveHTML=strHTML
Set objRegExp = Nothing
End Function
Dim Url,Html,sUrl,sHtml
<!--sUrl是你要取title的页面的URL，必须为完整路径-->
sUrl=""
Start="<title>"
last="</title>"
sHtml = getHTTPPage(sUrl)
dome=GetKey(sHTML,Start,Last)
response.Write dome
%>