我想获取一个网页里的所有url地址,也就是标记为href=""里面的所有网址,然后将这些网址组合成“,网址1,网址2,网址3,”的形式输出到变量urls里。请问asp代码怎么写啊?
一楼的不对。我要的是当前页面的所有链接标记里的网站,而不是当前网页的地址啊。
<%
'=====================================================================
'代码版权说明
'=====================================================================
' 文件名: GetHttpObj.asp
' 日期: 2006-11-28
' 作者: 阿建
' 版权所有:
重庆首页
' 用途:小偷对象
'=====================================================================
' Copyright (C) 2006 www.*****.com All rights reserved.
' Web:
http://www.*****.com
' Need help? Email To: Ran5261894@126.com QQ:165368576
'知余枯=====================================================================
Class GetHtmlContentObject
Private Gbasc,Bit,GetHttp
Private HtmlStr
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆
'作用:初始化类;
Private Sub Class_Initialize
Set GetHttp=Server.CreateObject("Microsoft.XMLHTTP")
End Sub
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆
'作用:同XML对象以二进制数据格式返回远程页面的内容;
'参数:要获取的页面地址;
Private Function GetHtmlBinary(Url)
With GetHttp
.Open "GET", Url, False
.Send
GetHtmlBinary = .ResponseBody
'对取得信搭洞息进行验证,如果信息长度小于100则说明截取失败
If LenB(.ResponseBody)<100 then
Response.Write "获取远程文件不存在。"
Response.End
End If
End With
End Function
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆
'作用:数据转换,将二进制数据转换为字符;
'参数:要转换的二进制数据;
Private Function GetBytes(MultiByte)
Dim Rsbt, LMultiByte, Binary
Const adLongVarBinary = 201
Set Rsbt = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
Rsbt.Fields.Append "毁禅mBinary",adLongVarBinary,LMultiByte
Rsbt.Open
Rsbt.AddNew
Rsbt("mBinary").AppendChunk MultiByte
Rsbt.Update
Binary = Rsbt("mBinary").GetChunk(LMultiByte)
End If
Set Rsbt=Nothing
GetBytes = Binary
End Function
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆
'作用:取得需要的内容;
Public Function GetHtmlContent(Url)
GetHtmlContent=GetBytes(GetHtmlBinary(Url))
End Function
'◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆◇◆
End Class
Public Function GetAddress(Url)
Dim Hobj,NewCont,I,M
Set Hobj = New GetHtmlContentObject
NewCont = LCase(Hobj.GetHtmlContent(Url))
NewCont = Split(NewCont,"<a href="&Chr(34))'有href="的
For I = 1 To Ubound(NewCont)
M = Instr(NewCont(I),Chr(34))
NewCont(I) = Left(NewCont(I),M-1)
GetAddress = GetAddress&NewCont(I)&"<br>"
Next
Set Hobj = Nothing
End Function
Response.Write(GetAddress("
http://www.newkiss.cn/Html/Down/DownInfo_1_1306.htm"))
%>
<%
'得到当前页面的地址
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables("HTTPS"唤芦雀)) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & Request.ServerVariables("SERVER_NAME"哗老)
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & Request.ServerVariables("和早SERVER_PORT")
strTemp = strTemp & Request.ServerVariables("URL")
If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & Trim(Request.QueryString)
GetUrl = strTemp
End Function
Response.write GetUrl()
%>