Как загрузить изображение с WEB страницы, не используя его URL адрес

Dragokas · Регистрация: 25.12.2011

Студворк — интернет-сервис помощи студентам

Задача: есть адрес веб-страницы, на которой расположена картинка.
Эта картинка при обновлении страницы меняется (скажем так - это каптча с постоянным URL-адресом).

Как программно сохранить ее на диск?
Для работы со страницей использую объект "InternetExplorer.Application"

Не по теме:

С Webbrowser какие-то проблемы. При проверке свойств .busy и .readystate иногда с вероятностью 50 % появляется ошибка "object does not support this property or method".

Я нашел класс для работы с кешем, но пока не разобрался,
как ним пользоваться и умеет ли он "вытягивать" картинки.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
Option Explicit
 
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
 
Private Type FILETIME
    lLowDateTime As Long
    lHighDateTime As Long
End Type
 
Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
 
Private Type INTERNET_CACHE_ENTRY_INFO
   dwStructSize As Long
   lpszSourceUrlName As Long
   lpszLocalFileName As Long
   CacheEntryType As Long
   dwUseCount As Long
   dwHitRate As Long
   dwSizeLow As Long
   dwSizeHigh As Long
   LastModifiedTime As FILETIME
   ExpireTime As FILETIME
   LastAccessTime As FILETIME
   LastSyncTime As FILETIME
   lpHeaderInfo As Long
   dwHeaderInfoSize As Long
   lpszFileExtension As Long
   dwExemptDelta As Long
End Type
 
Private Declare Function FindFirstUrlCacheEntry Lib "wininet.dll" Alias "FindFirstUrlCacheEntryA" ( _
        ByVal lpszSearchPattern As String, _
        ByVal lpCacheInfo As Long, _
        lpdwFirstCacheEntryInfoBufferSize As Long) As Long
    
Private Declare Function FindNextUrlCacheEntry Lib "wininet.dll" Alias "FindNextUrlCacheEntryA" ( _
        ByVal hEnumHandle As Long, _
        ByVal lpCacheInfo As Long, _
        lpdwNextCacheEntryInfoBufferSize As Long) As Long
 
Private Declare Function FindCloseUrlCache Lib "wininet.dll" ( _
        ByVal hEnumHandle As Long) As Long
        
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoA" ( _
        ByVal lpszUrlName As String, _
        ByVal lpCacheInfo As Long, _
        lpdwCacheEntryInfoBufferSize As Long) As Long
 
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String) As Long
    
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
  
Private hEnumHandle As Long
Private ci As INTERNET_CACHE_ENTRY_INFO
Private lPtrCI As Long
 
Public Property Get CachedEntryCacheType() As Long
    CachedEntryCacheType = ci.CacheEntryType
End Property
 
Public Property Get CachedEntryExpireTime() As Date
On Local Error Resume Next
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.ExpireTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryExpireTime = dExpire
End Property
 
Public Property Get CachedEntryFileExtension() As String
Dim strData As String
Dim lReturnValue As Long
Dim iPosition As Long
    strData = Space(250)
    lReturnValue = PtrToStr(strData, ci.lpszFileExtension)
    If lReturnValue Then
        iPosition = InStr(strData, Chr(0))
        CachedEntryFileExtension = Left$(strData, iPosition - 1)
    End If
End Property
 
Public Property Get CachedEntryLastAccessTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastAccessTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastAccessTime = dExpire
End Property
 
Public Property Get CachedEntryLastModifiedTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastModifiedTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastModifiedTime = dExpire
End Property
 
Public Property Get CachedEntryLastSyncTime() As Date
Dim dExpire As Date
Dim stSystemTime As SYSTEMTIME
Dim lReturnValue As Long
    lReturnValue = FileTimeToSystemTime(ci.LastSyncTime, stSystemTime)
    With stSystemTime
        dExpire = CDate(.wMonth & "/" & .wDay & "/" & .wYear & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
    End With
    CachedEntryLastSyncTime = dExpire
End Property
 
Public Property Get CachedEntryFileName() As String
Dim strData As String
Dim lReturnValue As Long
Dim iPosition As Long
    strData = String$(lstrlenA(ByVal ci.lpszLocalFileName), 0)
    lReturnValue = lstrcpyA(strData, ci.lpszLocalFileName)
    If lReturnValue Then CachedEntryFileName = strData
End Property
 
Public Property Get CachedEntrySourceURL() As String
Dim strData As String
Dim lReturnValue As Long
Dim iPosition As Long
    strData = String$(lstrlenA(ci.lpszSourceUrlName), 0)
    lReturnValue = lstrcpyA(strData, ci.lpszSourceUrlName)
    If lReturnValue Then CachedEntrySourceURL = strData
End Property
 
Public Function DeleteCacheEntry(SourceUrl As String) As Boolean
Dim lReturnValue As Long
    lReturnValue = DeleteUrlCacheEntry(SourceUrl)
    DeleteCacheEntry = CBool(lReturnValue)
End Function
 
Public Function FindEntryInCache(Url As String) As Boolean
Dim lReturnValue As Long, lSizeOfStruct As Long
    lReturnValue = GetUrlCacheEntryInfo(Url, 0&, lSizeOfStruct)
    If lPtrCI Then LocalFree lPtrCI
    lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
    If lPtrCI Then
        CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
        lReturnValue = GetUrlCacheEntryInfo(Url, lPtrCI, lSizeOfStruct)
        CopyMemory ci, ByVal lPtrCI, Len(ci)
        LocalFree lPtrCI
    End If
    FindEntryInCache = CBool(lReturnValue)
End Function
 
Public Function FindFirstCacheEntry() As Boolean
Dim lSizeOfStruct As Long
    If hEnumHandle <> 0 Then FindCloseUrlCache hEnumHandle
    hEnumHandle = FindFirstUrlCacheEntry(vbNullString, 0&, lSizeOfStruct)
    If lPtrCI Then LocalFree lPtrCI
    lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
    If lPtrCI Then
        CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
        hEnumHandle = FindFirstUrlCacheEntry(ByVal vbNullString, lPtrCI, lSizeOfStruct)
        CopyMemory ci, ByVal lPtrCI, Len(ci)
    End If
    FindFirstCacheEntry = CBool(hEnumHandle)
End Function
 
Public Function FindNextCacheEntry() As Boolean
Dim lReturnValue As Long, lSizeOfStruct As Long
    If hEnumHandle <> 0 Then
        lReturnValue = FindNextUrlCacheEntry(hEnumHandle, 0&, lSizeOfStruct)
        If lPtrCI Then LocalFree lPtrCI
        lPtrCI = LocalAlloc(LMEM_FIXED, lSizeOfStruct)
        If lPtrCI Then
            CopyMemory ByVal lPtrCI, lSizeOfStruct, 4
            lReturnValue = FindNextUrlCacheEntry(hEnumHandle, lPtrCI, lSizeOfStruct)
            CopyMemory ci, ByVal lPtrCI, Len(ci)
        End If
        If lReturnValue <> 0 Then FindNextCacheEntry = CBool(lReturnValue)
    End If
End Function
 
Private Sub Class_Terminate()
    If hEnumHandle Then Call FindCloseUrlCache(hEnumHandle)
End Sub

Еще нашел код, который копирует в буфер сам объект Image.
Он у меня на веб-странице такой 1. Фильтром находится правильно. Имеет тип HTMLImg ("[Object HTMLImageElement]")
Но при попытке добавления к ControlRange объекта HTMLImg получаю ошибку: "object does not support this property or method".

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Command1_Click()
 
    Dim sURL As String: sURL = "https://eu.battle.net/account/creation/tos.html?country=RUS"
 
    Dim appIE As Object 'SHDocVw.InternetExplorer
    Set appIE = CreateObject("InternetExplorer.Application")
 
    With appIE
        .Navigate sURL
        .Visible = True
        '.Silent = True
        '.FullScreen = True
 
        Do While (.Busy Or .readyState <> 4): DoEvents: Loop
 
        Dim D As Object 'MSHTML.HTMLDocument
        Set D = .Document
 
    End with
 
    'Dim f As Object
    'Set f = D.getElementById("sec-string") '// input captcha
 
    'D.Forms("creation").All("captchaInput").Value = "captchaDecode"
 
        Dim x, ctrlRange
        
        For Each x In appIE.Document.All
            If UCase(x.tagName) = UCase("IMG") Then
            '    If InStr(1, UCase(x.src), UCase(imgurl), 1) > 0 Then
                    Stop
                    Set ctrlRange = appIE.Document.body.createControlRange()
                    'Debug.Print x.tagName, x.src
                    ctrlRange.Add (x)
                    Clipboard.Clear
                    ctrlRange.execCommand ("Copy")
                    SavePicture Clipboard.GetData, App.Path & "\1.bmp" ' is used to save the picture to your hard drive
                    Picture1.Picture = Clipboard.GetData
                    Stop
                    'Exit For
            '    End If
            End If
        Next
 
end sub

Dragokas · 16.06.2013, 04:43 **[ТС]**

P.S. Не очень актуально.

Сделал на Си-решётке:

Кликните здесь для просмотра всего текста

C#
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
using System;
using mshtml;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Text;
using System.Windows.Forms;
using System.Runtime.InteropServices;
 
namespace Battle_net_Download_Captcha_cs
{
    public partial class Form1 : Form
    {
        public Form1()
        {
            InitializeComponent();
        }
 
        [ComImport, InterfaceType((short)1), Guid("3050F669-98B5-11CF-BB82-00AA00BDCE0B")]
        private interface IHTMLElementRenderFixed
        {
            void DrawToDC(IntPtr hdc);
            void SetDocumentPrinter(string bstrPrinterName, IntPtr hdc);
        }
 
 
        void GetImage(string id)
        {
            HtmlDocument D = webBrowser1.Document;
            
            HtmlElement e = D.GetElementById(id);
 
            int i = 0;
 
            MessageBox.Show("Процедура");
 
            //foreach (mshtml.IHTMLImgElement img in webBrowser1.Document.Images)
            //{
            //    MessageBox.Show("Картинка");
 
            HtmlElementCollection collection = D.Images;
            foreach (HtmlElement c in collection)
            {
                MessageBox.Show(c.Id);
 
                IHTMLImgElement img = (IHTMLImgElement)c.DomElement; // e.DomElement (for parsed element)
                IHTMLElementRenderFixed render = (IHTMLElementRenderFixed)img;
 
                Bitmap bmp = new Bitmap(img.width, img.height);
                Graphics g = Graphics.FromImage(bmp);
                IntPtr hdc = g.GetHdc();
                render.DrawToDC(hdc);
                g.ReleaseHdc(hdc);
 
                bmp.Save("C:\\temp\\captcha" + i + ".png");
 
                MessageBox.Show("Готово");
 
                i ++;
            }
            //return bmp;
        }
 
 
        private void button1_Click(object sender, EventArgs e)
        {
            webBrowser1.Navigate("https://eu.battle.net/account/creation/tos.html?country=RUS");
        }
 
        private void webBrowser1_DocumentCompleted(object sender, WebBrowserDocumentCompletedEventArgs e)
        {
            if (e.Url.AbsolutePath != (sender as WebBrowser).Url.AbsolutePath)
                return;
 
            while (webBrowser1.IsBusy || webBrowser1.ReadyState != WebBrowserReadyState.Complete)
            {
                Application.DoEvents();
                //System.Threading.Thread.Sleep(100);
            }
 
            //captchaInput
            //Bitmap img = GetImage("sec-string");
 
            GetImage("sec-string");
        }
    }
}

За бугром одни недопилки и примеры с urldownload.

Может, кому будет интересно допилить на VB6 через BltBlt по примеру выше.

Новые блоги и статьи Все статьи Все блоги /
Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .
Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .

Как загрузить изображение с WEB страницы, не используя его URL адрес

Решение