Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Интернет/Почта/Сеть  
     
  Как вытащить все ссылки из htm-страницы  
  В одном из многочисленных примеров по работе с компонентом 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
 
     
  VBNet online (всего: 51566)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам