用vb从网页源代码中抽取url
发布网友
发布时间：2024-10-06 11:09
共1个回答
热心网友
时间：2024-10-24 17:36
'例子需控件：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
