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

None.gif ' ///
None.gif
Imports  System.IO
None.gif
Imports  System.Net
None.gif
Imports  System
None.gif
Imports  System.Text
None.gif
Imports  System.Text.RegularExpressions
ExpandedBlockStart.gifContractedBlock.gif
Public   Class HTMLContentParser Class HTMLContentParser
ExpandedSubBlockStart.gifContractedSubBlock.gif
Function Return_HTMLContent()Function Return_HTMLContent(ByVal sURL As String)
InBlock.gif
Dim sStream As Stream
InBlock.gif
Dim URLReq As HttpWebRequest
InBlock.gif
Dim URLRes As HttpWebResponse
InBlock.gif
Try
InBlock.gifURLReq 
= WebRequest.Create(sURL)
InBlock.gifURLRes 
= URLReq.GetResponse()
InBlock.gifsStream 
= URLRes.GetResponseStream()
InBlock.gif
Return New StreamReader(sStream).ReadToEnd()
InBlock.gif
Catch ex As Exception
InBlock.gif
Return ex.Message
InBlock.gif
End Try
ExpandedSubBlockEnd.gif
End Function

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

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

ExpandedSubBlockStart.gifContractedSubBlock.gif
Private Function ProcessURL()Function ProcessURL(ByVal sInput As StringByVal sURL As String)
InBlock.gif
'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
InBlock.gif
sURL += "/"
InBlock.gif
End If
InBlock.gif
'FILTERING
InBlock.gif'
Filter down to the Domain Name Directory from the Right
InBlock.gif
Dim iCount As Integer
InBlock.gif
For iCount = sURL.Length To 1 Step -1
InBlock.gif
If Mid(sURL, iCount, 1= "/" Then
InBlock.gifsURL 
= Left(sURL, iCount)
InBlock.gif
Exit For
InBlock.gif
End If
InBlock.gif
Next
InBlock.gif
'Filter out the ">" from the Left
InBlock.gif
For iCount = 1 To sInput.Length
InBlock.gif
If Mid(sInput, iCount, 4= ">" Then
InBlock.gifsInput 
= Left(sInput, iCount - 1'Stop and Take the Char before
InBlock.gif
Exit For
InBlock.gif
End If
InBlock.gif
Next
InBlock.gif
'Filter out unnecessary Characters
InBlock.gif
sInput = sInput.Replace("<"Chr(39))
InBlock.gifsInput 
= sInput.Replace(">"Chr(39))
InBlock.gifsInput 
= sInput.Replace(""", "")
InBlock.gif
sInput = sInput.Replace("'""")
InBlock.gif
If (sInput.IndexOf("http://"< 0Then
InBlock.gif
If (Not (sInput.StartsWith("/")) And Not (sURL.EndsWith("/"))) Then
InBlock.gif
Return sURL & "/" & sInput
InBlock.gif
Else
InBlock.gif
If (sInput.StartsWith("/")) And (sURL.EndsWith("/")) Then
InBlock.gif
Return sURL.Substring(0, sURL.Length - 1+ sInput
InBlock.gif
Else
InBlock.gif
Return sURL + sInput
InBlock.gif
End If
InBlock.gif
End If
InBlock.gif
Else
InBlock.gif
Return sInput
InBlock.gif
End If
ExpandedSubBlockEnd.gif
End Function

ExpandedBlockEnd.gif
End Class

None.gif

转载于:https://www.cnblogs.com/Contlu/archive/2004/11/27/69534.html

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值