| |
В одном из многочисленных примеров по работе с
компонентом WebBrowser я натолкнулся на пример, как
можно вытащить все ссылки из любого *.htm файла,
находящегося как в интернете, так и локально на
жестком диске. Честно говоря, моя жизнь после
нахождения данного примера очень облегчилась,
поскольку я часто работаю с инетом, со ссылками.
Нажатие на первую кнопку покажет, как можно
вытащить все ссылки из файла, а нажатие на вторую
кнопку - как можно вытащить ссылки только
определенного типа.
Но для начала вам надо установить через меню Project
| References ссылку на Microsoft Internet Control.
ПРИМЕР 1
Также вам необходимо расположить на форме 2
элемента CommandButton и элемент ListBox.
Private IEBroj1 As SHDocVw.InternetExplorer
Private Sub Form_Load()
Set IEBroj1 = New SHDocVw.InternetExplorer
End Sub
Private Sub Form_Unload(Cancel As Integer)
IEBroj1.Quit
Set IEBroj1 = Nothing
End
End Sub
Function Delay(Pause As Single)
Dim Start As Single
Start = Timer
Do While Timer < Start + Pause
DoEvents
Loop
End Function
Private Sub Command1_Click()
List1.Clear
Dim x
IEBroj1.Navigate "C:\1\index.htm"
Delay 3 'задержа необходима для загрузки страницы
'иногда требуется увеличить время загрузки до 30
секунд.
For i = 1 To IEBroj1.Document.links.length - 1
List1.AddItem IEBroj1.Document.links(i).href
Next
End Sub
Private Sub Command2_Click()
List1.Clear
Dim x
IEBroj1.Navigate "C:\1\index.htm"
Delay 3
For i = 1 To IEBroj1.Document.links.length - 1
If InStr(1, IEBroj1.Document.links(i).href, ".asp") <> 0 Or InStr(1,
IEBroj1.Document.links(i).href, ".htm") <> 0 Then
List1.AddItem IEBroj1.Document.links(i).href
End If
Next
End Sub
ПРИМЕР 2: Расположите на форме элемент
CommandButton и элемент ListBox.
Dim X, Y,
St1, St2, tmpY As Integer
Private Sub Command1_Click()
StripEmail ("D:\vbcode\index.htm")
List1.AddItem "=============="
StripURL ("D:\vbcode\index.htm")
End Sub
Public Sub StripEmail(FilePath As String)
Dim tmpEmail1, tmpEmail2 As String
Open FilePath For Input As #1
Do Until EOF(1)
Input #1, tmpEmail1
For X = 1 To Len(tmpEmail1)
tmpEmail2 = Mid(tmpEmail1, X, 7)
If tmpEmail2 = "mailto:" Then
St1 = X
tmpY = X + 1
For Y = 1 To Len(tmpEmail1)
tmpEmail2 = Mid(tmpEmail1, tmpY, 1)
If tmpEmail2 = Chr(34) Then
St2 = tmpY
tmpEmail2 = Mid(tmpEmail1, St1 + 7, ((St2 - St1) - 7))
If (Left(tmpEmail2, 2) <> "//") And (Left(tmpEmail2, 1) <> "
") Then
List1.AddItem tmpEmail2
Exit For
End If
End If
tmpY = tmpY + 1
Next Y
End If
Next X
Loop
Close #1
End Sub
Public Sub StripURL(FilePath As String)
Dim tmpURL1, tmpURL2 As String
Open FilePath For Input As #1
Do Until EOF(1)
Input #1, tmpURL1
For X = 1 To Len(tmpURL1)
tmpURL2 = Mid(tmpURL1, X, 7)
If tmpURL2 = "http://" Then
St1 = X
tmpY = X
For Y = 1 To Len(tmpURL1)
tmpURL2 = Mid(tmpURL1, tmpY, 1)
If tmpURL2 = Chr(34) Then
St2 = tmpY
List1.AddItem Mid(tmpURL1, St1, ((St2 - St1)))
Exit For
Else
tmpY = tmpY + 1
End If
Next Y
End If
Next X
Loop
Close #1
End Sub
|
|