用vb从网页源代码中抽取url

从文件中提取所有url，显示到文本框中
'例子需控件：Command1、Text1
'Text1 要设置成多行显示
Private Sub Command1_Click()
Dim F As String
F = "C:\My.htm"
Call GetAllStr(F, " href=" & Chr(34), Chr(34))
End Sub

Private Sub GetAllStr(F As String, Find1 As String, Find2 As String)
Dim nStr As String, H As Long, B() As Byte, S As Long
Dim FindStart As Long, IsFond As Boolean, Str1 As String, nFond As String

On Error GoTo Cuo
S = FileLen(F)
ReDim B(1 To S)
H = FreeFile
Open F For Binary As #H
Get #H, , B
Close #H
nStr = StrConv(B, vbUnicode)

FindStart = 1
Do
Str1 = GetStr(nStr, FindStart, Find1, Find2, IsFond)
If Not IsFond Then Exit Do
If Str1 <> "" Then nFond = nFond & Str1 & vbCrLf
XiaS:
Loop
Text1.Text = F & vbCrLf & "查找结果：" & vbCrLf & nFond
Exit Sub
Cuo:
MsgBox "文件没有找到：" & vbCrLf & F, vbInformation
End Sub

Private Function GetStr(nStr As String, FindStart As Long, StrQ As String, StrH As String, Optional IsFond As Boolean) As String
Dim sQ As Long, sH As Long, LongQ As Long, LongH As Long

IsFond = False
LongQ = Len(StrQ): LongH = Len(StrH)

If LongQ > 0 Then sQ = InStr(FindStart, nStr, StrQ, vbTextCompare) Else sQ = FindStart
If sQ = 0 Then Exit Function

If LongH > 0 Then sH = InStr(sQ + LongQ, nStr, StrH, vbTextCompare) Else sH = 1 + Len(nStr)
If sH = 0 Then Exit Function

GetStr = Mid(nStr, sQ + LongQ, sH - sQ - LongQ)
FindStart = sH + LongH
IsFond = True
End Function