Отправить GET и получить картинку)

[eldar22]

Вот вопрос?
Как отправить get запрос и получить в ответе?
Я знаю как на delphi это организовать

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var
f:tfilestream;
Im: TJpegImage;
begin



Im := TJpegImage.Create;
f:=tfilestream.Create('c:\temp.jpeg',fmcreate);

IdHTTP1.get('http://filgab.ex6.ru/engine/modules/antibot.php',f);

f.Free;

image1.Picture.LoadFromFile('c:\temp.jpeg');
end;

end.

А вот как на vb организовать я незнаю

[Williams]

Например, почитать FAQ по Winsock контролу. Можно еще urldownloadtofile

[eldar22]

Забыл сказать
GET запрос я знаю как отправить

Код: Выделить всё

Dim strURL As String
Dim strToASP As String
Dim strHeader As String

strHeader = "Host: filgab.ex6.ru" & vbNewLine & _
            "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MRSPUTNIK 2, 0, 1, 90 SW; MRA 5.4 (build 02620); .NET CLR 2.0.50727; Dealio Toolbar 3.4; InfoPath.1)" & vbNewLine & _
            "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" & vbNewLine & _
            "Accept-Language: ru,en-us;q=0.7,en;q=0.3" & vbNewLine & _
            "Accept-Encoding: gzip,deflate" & vbNewLine & _
            "Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7" & vbNewLine & _
            "Keep-Alive: 300" & vbNewLine & _
            "Referer: http://filgab.ex6.ru/" & vbNewLine & _
               "Connection: keep-alive" & vbNewLine



strToASP = ""

strURL = "http://filgab.ex6.ru/engine/modules/antibot.php"
Inet1.Execute strURL, "get", strToASP, strHeader

[Williams]

Забыл сказать
GET запрос я знаю как отправить

Ты забыл вставить блок "НО", то бишь сформировать вопрос. Телепатия нынче не в моде.

[eldar22]

Вот что у меня получилось картинку он сохраняет, НО как сделать, чтобы без вот этого был If Size = 0 Then Size = Inet1.GetHeader("Content-length"): Label1 = "Всего: " & Size: DoEvents

Код: Выделить всё

Option Explicit
Dim Size As Long, Got As String
Private Sub Command1_Click()
  Dim strURL As String
Dim strToASP As String
Dim strHeader As String
Inet1.AccessType = icDirect

strHeader = "Host: www.filgab.ex6.ru" & vbNewLine & _
            "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 MRA 5.4 (build 02620) Firefox/3.0.10" & vbNewLine & _
            "Accept: image/png,image/*;q=0.8,*/*;q=0.5" & vbNewLine & _
            "Accept-Language: ru,en-us;q=0.7,en;q=0.3" & vbNewLine & _
            "Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7" & vbNewLine & _
            "Keep-Alive: 300" & vbNewLine & _
            "Referer: http://filgab.ex6.ru/" & vbNewLine & _
            "Connection: keep-alive" & vbNewLine



strToASP = ""

strURL = "http://filgab.ex6.ru/engine/modules/antibot.php"
Inet1.Execute strURL, "get", strToASP, strHeader
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim s As String
If State = icResponseReceived Then
    If Size = 0 Then Size = Inet1.GetHeader("Content-length"): Label1 = "Всего: " & Size: DoEvents
    Do
        On Error GoTo Away
        s = Inet1.GetChunk(1024, icByteArray)
        If 0 = Len(s) Then Exit Do
        Got = Got & StrConv(s, vbUnicode)
        Label2 = "Получено: " & Len(Got)
        If Len(Got) = Size Then
            Open "output" For Output As 1
            Print #1, Got;
            Close 1
            Exit Do
        Else
            DoEvents
        End If
    Loop
Away:
End If
End Sub


[Xcode]

Расставляй знаки препинания, не на заборе пишешь.
Всмысле без вот этого? Ты понимаешь зачем эта строка нужна, и как весь код работает?

[eldar22]

Ну это строка нужна, чтобы размер знать сколько закачано если я не ошибаюсь
Я имею ввиду, если использовать этот код на других серверах, который в ответ не посылает Content-length то при работе будет ругаться вот на это Inet1.GetHeader("Content-length")
Поэтому прошу помощи.

[arvitaly]

Если сервера не выдают этот заголовок узнать размер не получится, только скачать полностью.
Если ругаются ну не знаю поставь on error или научись делать нормально

[eldar22]

Да не нужно мне знать размер

[Xcode]

Ты ошибаешься, эта строчка служит для определения размера присылаемого контента.
По идее этот заголовок должен сопровождать любой запрос, содержащий тело(контент). Слудет ли считать что если он отсутсвует, то и контента нет?
Как это тебе не надо знать размер? И до каких пор ты будешь собирать данные, которые тебе шлет сервер?
Ну не нужно, так не нужно. Делай как знаешь. Хотя может и я чего-то не знаю еще.

[arvitaly]

Ну не нужно, так не нужно. Делай как знаешь. Хотя может и я чего-то не знаю еще.

Не знаешь

http://nagl.ru/user/files/2d6cc4b2d139a ... bb3086ae2e

Есть контент нет? И как же ты скачиваешь если должен бесконечно?

[Xcode]

Не знаешь

Чего не знаю?

[iGrok]

Вообще говоря, если не стоит Content-Length, должен стоять Transfer-Encoding: chunked
И тогда надо разбирать чанки с информацией. Если длина чанка - 0, значит передали всё.
Если надо подробнее - кину ссылку..

UPD:
А вот даже так:
http://www.w3.org/Protocols/rfc2616/rfc ... tml#sec4.4

Итого:
1) Transfer-Encoding
2) Content-Length
3) Byte-ranges
4) Connection: close

[eldar22]

Эх все равно не поняли
Модераторы закройте тему пожалуйста

[iGrok]

Эх все равно не поняли
Модераторы закройте тему пожалуйста

Да все тебя поняли.
Поставь проверку на существование этого хидера перед присвоением, чтобы код не ругался.
И посмотри, нормально ли скачается файл, ссылку на который дал arvitaly.
Если нормально - то и всё. Если нет (а мне почему-то кажется, что нет), значит придётся выдирать размер по другому.

А вообще, я бы на твоём месте взял из кирпичей качалку Тёмыча, и не парился с этими высокими материями...

[eldar22]

Ещё раз говорю не нужно мне знать размер файл!
Тема моего поста" Отправить GET и получить картинку" а не скачать и узнать размер файла!
Я просто привёл код этот, потому что только так смог получить нужную картинку ну, а теперь встала проблема на одном сервере работает скрипт, который посылает картинку, но в ответе не посылает Content-length, а код который я привёл работает только с сервером который посылает Content-length

[arvitaly]

Код: Выделить всё

Option Explicit
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer



'Purpose     :  Retreview text from a web site
'Inputs      :  sServerName             The server name where the file is located eg.
'               sFileName               The file name to download eg. "index.asp" or "/code/codetoc.asp"
'               [sUsername]             If required, the login user name.
'               [sPassword]             If required, the user's password.
'               [lBufferSize]           The size of that the packets data downloaded in.
'Outputs     :  The contents of the specified file
'Notes       :  Can be used through a proxy server by specifying a username and password
'Revisions   :

Function InternetGetText(sServerName As String, sFileName As String, Optional sUsername As String = vbNullString, Optional sPassword As String = vbNullString, Optional lBufferSize As Long = -1) As String
    Dim hInternetSession As Long, hInternetConnect As Long, hHttpOpenRequest As Long
    Dim lRetVal As Long, lLenFile As Long, lNumberOfBytesRead As Long, lResLen As Long
    Dim sBuffer As String, lTotalBytesRead As Long
   
    Const clBufferIncrement As Long = 2000, scUserAgent As String = "VBUsers"
    Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000
    Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3
    Const INTERNET_DEFAULT_HTTP_PORT = 80, INTERNET_FLAG_RELOAD = &H80000000
    Const INTERNET_SERVICE_HTTP = 3
    Const HTTP_QUERY_CONTENT_LENGTH = 5
   
    If lBufferSize = -1 Then
        'Create an arbitary buffer to read the whole file in parts
        sBuffer = String$(clBufferIncrement, vbNullChar)
        lBufferSize = clBufferIncrement
    Else
        'Create a specified buffer size
        sBuffer = String$(lBufferSize, vbNullChar)
    End If
   
    'Initializes an application's use of the Win32 Internet functions
    hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    'Opens an FTP, Gopher, or HTTP session for a given site
    hInternetConnect = InternetConnect(hInternetSession, sServerName, INTERNET_DEFAULT_HTTP_PORT, sUsername, sPassword, INTERNET_SERVICE_HTTP, 0, 0)
    'Create an HTTP request handle
    hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", sFileName, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
   
    'Creates a new HTTP request handle and stores the specified parameters in that handle
    lRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, 0, 0)
    If lRetVal Then
        'Determine the file size
        lResLen = lBufferSize
        lRetVal = HttpQueryInfo(hHttpOpenRequest, HTTP_QUERY_CONTENT_LENGTH, ByVal sBuffer, lResLen, 0)
        If lRetVal Then
            'Successfully returned file length
            lLenFile = Val(Left$(sBuffer, lResLen))
            'Create a buffer to hold file
            sBuffer = String$(lLenFile, vbNullChar)
            lBufferSize = lLenFile
        Else
            'Unable to establish file length
            lLenFile = -1
        End If
       
        'Read the file
        Do
            lRetVal = InternetReadFile(hHttpOpenRequest, sBuffer, lBufferSize, lNumberOfBytesRead)
            'Store the results
            InternetGetText = InternetGetText & Left$(sBuffer, lNumberOfBytesRead)
            lTotalBytesRead = lTotalBytesRead + lNumberOfBytesRead
            If lNumberOfBytesRead = 0 Or lTotalBytesRead = lLenFile Or lRetVal = 0 Then
                'Finished reading file
                Exit Do
            End If
        Loop
    End If
    'Close handles
    InternetCloseHandle hHttpOpenRequest
    InternetCloseHandle hInternetSession
    InternetCloseHandle hInternetConnect
End Function

'Demonstration routine
'(Note the Debug window will only show the last 255 lines)
Sub Test()
    Dim sInternetFile As String
    sInternetFile = InternetGetText("www.nagl.ru", "/index.php", "myusername", "mypassword")
    Debug.Print "File Donwloaded: " & vbNewLine
    Debug.Print sInternetFile
End Sub


На поизучай

[iGrok]

Ещё раз говорю не нужно мне знать размер файл!
Тема моего поста" Отправить GET и получить картинку" а не скачать и узнать размер файла!
Я просто привёл код этот, потому что только так смог получить нужную картинку ну, а теперь встала проблема на одном сервере работает скрипт, который посылает картинку, но в ответе не посылает Content-length, а код который я привёл работает только с сервером который посылает Content-length

А вообще, я бы на твоём месте взял из кирпичей качалку Тёмыча, и не парился с этими высокими материями...

Ты эту фразу не увидел, да?

[eldar22]

Повторяю не нужна мне качалка, я не хочу качать файл не хочу знать его размер или сколько скачалось
Просто только так я смог получить картинку

Вот код совсем другой Проблема в том что не могу к нему привязать Хедеры
То есть вот это

Код: Выделить всё

strHeader = "Host: www.filgab.ex6.ru" & vbNewLine & _
            "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 MRA 5.4 (build 02620) Firefox/3.0.10" & vbNewLine & _
            "Accept: image/png,image/*;q=0.8,*/*;q=0.5" & vbNewLine & _
            "Accept-Language: ru,en-us;q=0.7,en;q=0.3" & vbNewLine & _
            "Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7" & vbNewLine & _
            "Keep-Alive: 300" & vbNewLine & _
            "Referer: http://filgab.ex6.ru/" & vbNewLine & _
            "Connection: keep-alive" & vbNewLine

Код: Выделить всё

Private Sub Command1_Click()
Dim b As Byte
           
Inet1.URL = "http://filgab.ex6.ru/engine/modules/antibot.php"
b = Inet1.OpenURL(Inet1.URL, icByteArray)
Open "c:\test.jpeg" For Binary Access Write As #1
Put #1, , b
Close #1
End Sub

Ещё раз повторяю я делаю не качалку файлов

[Хакер]

Т.е. ты один из тех, кто хочет получить картинку, не скачивая её, прочитать книгу, не открывая её и т.п.?

[eldar22]

Хакер
Издеваетесь, Придираетесь к каждому слову
Вы же понимаете что я имел ввиду

[alibek]

Нет, он хочет, чтобы картинка была в памяти.
Только сделать этого он не сможет. Для этого надо хотя бы минимальные усилия приложить к тому, чтобы понять уже данные советы.

[eldar22]

alibek
Нет ты меня не понял

[Хакер]

Хакер
Издеваетесь, Придираетесь к каждому слову
Вы же понимаете что я имел ввиду

Я терпеть не могу эту совокупность высказываний. И делеко не к каждому, кстати.

[Xcode]

Повторяю не нужна мне качалка, я не хочу качать файл не хочу знать его размер или сколько скачалось
...
Ещё раз повторяю я делаю не качалку файлов

Закрывайте тему.

[djalex777]

Почитал, подумал... eldar22 постеснялся внятно изложить проблему.А проблема у него видимо в том, что он хочет сымитировать заход пользователя на страницу и получить изображение с защитой от авто(подставляем_нужное_слово), и никак не может сформировать (или приаттачить) хедер. Сделай всё тоже самое через WinHTTPRequest или XMLRequest.

[arvitaly]

Почитал, подумал... eldar22 постеснялся внятно изложить проблему.А проблема у него видимо в том, что он хочет сымитировать заход пользователя на страницу и получить изображение с защитой от авто(подставляем_нужное_слово), и никак не может сформировать (или приаттачить) хедер. Сделай всё тоже самое через WinHTTPRequest или XMLRequest.

Серьезно ты не врешь? Вот оно чо

[iGrok]

А мужики-то не знают... ©

Свой совет насчёт качалки снимаю, да. Там реферера не приделать.

А ответ каким был, таким и остаётся - игнорировать хидер с длиной сообщения. Если не получится, т.е. часть файлов качаться не будет - смотреть, о чём я писал несколькими постами выше на предмет определения длины контета без этого хидера, и определять Size по другому.

[eldar22]

А вот как эти хедеры прикрепить?
Я знаю как прикрепить хедеры в это
Inet1.Execute

А вот как в Inet1.OpenURL там всего два значение url и тип данных
Inet1.OpenURL(strURL, icByteArray)
Хедеры ну не как не могу отправить какие нужны
Вот что у меня получается отправлять

GET /engine/modules/antibot.php HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*
User-Agent: Microsoft URL Control - 6.01.9782
Host: filgab.ex6.ru
Cache-Control: no-cache
Cookie: PHPSESSID=22e7a49a213c955ec4cbdbb1e82c8fcb

[eldar22]

Код: Выделить всё

Private Sub Command1_Click()
Dim strHeader As String
Dim strToASP As String
Dim strURL As String
strHeader = "Host: www.filgab.ex6.ru" & vbNewLine & _
            "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 MRA 5.4 (build 02620) Firefox/3.0.10" & vbNewLine & _
            "Accept: image/png,image/*;q=0.8,*/*;q=0.5" & vbNewLine & _
            "Accept-Language: ru,en-us;q=0.7,en;q=0.3" & vbNewLine & _
            "Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7" & vbNewLine & _
            "Keep-Alive: 300" & vbNewLine & _
            "Referer: http://filgab.ex6.ru/" & vbNewLine & _
            "Connection: keep-alive" & vbNewLine
            strURL = "http://filgab.ex6.ru/engine/modules/antibot.php"
            strToASP = ""
Inet1.Execute strURL, "get", strToASP, strHeader

End Sub




Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim vtData() As Byte
Dim intFile As Long

Select Case State
   'здесь можно обрабатывать другие события
   Case icResponseCompleted '12
      'открываем файл для записи принимаемых данных
      intFile = FreeFile
        Open "Capcha" For Binary Access Write As #intFile
      'принимаем первую порцию данных
      vtData = Inet1.GetChunk(1024, icByteArray)
        Do While LenB(CStr(vtData)) > 0
            Put #intFile, , vtData
            'следующая порция данных
            vtData = Inet1.GetChunk(1024, icByteArray)
           
        Loop
        Put #intFile, , vtData
        Close #intFile
End Select

End Sub


Вопрос решён