得到一个html网页上所有链接

   日期:2024-12-16     作者:czdytfhm4      
核心提示:'///////////////////////////ImportsSystem.IOImportsSystem.NetImportsSystemImportsSystem.TextImportsSystem.Text.RegularEx
'///////////////////////////
Imports System.IO
Imports System.Net
Imports System
Imports System.Text
Imports System.Text.RegularExpressions
Public Class HTMLContentParser
Function Return_HTMLContent(ByVal sURL As String)
Dim sStream As Stream
Dim URLReq As HttpWebRequest
Dim URLRes As HttpWebResponse
Try
URLReq 
= WebRequest.Create(sURL)
URLRes 
= URLReq.GetResponse()
sStream 
= URLRes.GetResponseStream()
Return New StreamReader(sStream).ReadToEnd()
Catch ex As Exception
Return ex.Message
End Try
End Function

Function ParseHTMLLinks(ByVal sHTMLContent As StringByVal sURL As StringAs ArrayList
Dim rRegEx As Regex
Dim mMatch As Match
Dim aMatch As New ArrayList()
rRegEx 
= New Regex("a.*hrefs*=s*(?:""(?<1>[^""]*)""|(?<1>S+))", _ RegexOptions.IgnoreCase Or RegexOptions.Compiled)
mMatch 
= rRegEx.Match(sHTMLContent)
While mMatch.Success
Dim sMatch As String
sMatch 
= ProcessURL(mMatch.Groups(1).ToString, sURL)
aMatch.Add(sMatch)
mMatch 
= mMatch.NextMatch()
End While
Return aMatch
End Function

Function ParseHTMLImages(ByVal sHTMLContent As StringByVal sURL As StringAs ArrayList
Dim rRegEx As Regex
Dim mMatch As Match
Dim aMatch As New ArrayList()
rRegEx 
= New Regex("img.*srcs*=s*(?:""(?<1>[^""]*)""|(?<1>S+))", _ RegexOptions.IgnoreCase Or RegexOptions.Compiled)
mMatch 
= rRegEx.Match(sHTMLContent)
While mMatch.Success
Dim sMatch As String
sMatch 
= ProcessURL(mMatch.Groups(1).ToString, sURL)
aMatch.Add(sMatch)
mMatch 
= mMatch.NextMatch()
End While
Return aMatch
End Function

Private Function ProcessURL(ByVal sInput As StringByVal sURL As String)
'Find out if the sURL has a "/" after the Domain Name 'If not, give a "/" at the end 'First, check out for any slash after the 'Double Dashes of the http:// 'If there is NO slash, then end the sURL string with a SLASH If InStr(8, sURL, "/") = 0 Then
sURL += "/"
End If
'FILTERING
'
Filter down to the Domain Name Directory from the Right
Dim iCount As Integer
For iCount = sURL.Length To 1 Step -1
If Mid(sURL, iCount, 1= "/" Then
sURL 
= Left(sURL, iCount)
Exit For
End If
Next
'Filter out the ">" from the Left
For iCount = 1 To sInput.Length
If Mid(sInput, iCount, 4= ">" Then
sInput 
= Left(sInput, iCount - 1'Stop and Take the Char before
Exit For
End If
Next
'Filter out unnecessary Characters
sInput = sInput.Replace("<"Chr(39))
sInput 
= sInput.Replace(">"Chr(39))
sInput 
= sInput.Replace(""", "")
sInput = sInput.Replace("'""")
If (sInput.IndexOf("http://"< 0Then
If (Not (sInput.StartsWith("/")) And Not (sURL.EndsWith("/"))) Then
Return sURL & "/" & sInput
Else
If (sInput.StartsWith("/")) And (sURL.EndsWith("/")) Then
Return sURL.Substring(0, sURL.Length - 1+ sInput
Else
Return sURL + sInput
End If
End If
Else
Return sInput
End If
End Function

End Class
     本文地址:http://w.yusign.com/tjnews/870.html    述古往 http://w.yusign.com/static/ , 查看更多
 
特别提示:本信息由相关用户自行提供,真实性未证实,仅供参考。请谨慎采用,风险自负。

举报收藏 0打赏 0
 
更多>同类生活信息

相关文章
最新文章
推荐文章
推荐图文
生活信息
点击排行
{
网站首页  |  关于我们  |  联系方式  |  用户协议  |  隐私政策  |  版权声明  |  网站地图  |  排名推广  |  广告服务  |  积分换礼  |  网站留言  |  RSS订阅  |  违规举报  |  鄂ICP备2020018471号