сохранить html страницу с картинками

[moshkin]

Нужно сохранять html страницы из интернета на диск вместе с картинками.
На сайте www.vbnet.ru есть пример кода (см. ниже)
Он хорошо работает, но картинок конечно не сохраняет.
Мне нужно самому искать в сохраненном html теги указывающие на картинки и скачивать картинки отдельно в созданную директорию с таким же названием?
Скажите пожалуйста, я прав? или можно как-то чуть проще это сделать?
Спасибо.

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Command1_Click()
DownloadFile "http://sharig.webzone.ru", "c:\sharig_webzone_ru.htm"
End Sub

[Ducis]

Мне нужно самому искать в сохраненном html теги указывающие на картинки и скачивать картинки отдельно в созданную директорию с таким же названием?
Скажите пожалуйста, я прав?

Думаю, прав. Вот еще код как можно вытащить все ссылки из любого *.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