winhttp отправка файлов

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

winhttp отправка файлов

Сообщение kifiro » 01.02.2015 (Вс) 18:31

Нужно реализовать отправку фоток на авито, отправляю картинку post запросом через WinHttpRequest.
Скрипт должен ответить в формате
Код: Выделить всё
{"1390610004":"//04.img.avito.st/80x60/1390610004.jpg"}

Я получаю:
Код: Выделить всё
{"error":"Неизвестный формат изображения"}

вот мой код:\
Код: Выделить всё
Set HTTP = New WinHttp.WinHttpRequest
bound = "----WebKitFormBoundaryMgS2xkEu1AflNCeY"
a1 = "Content-Disposition: form-data; name=image[]; filename=c:\avito\1.jpeg"
a2 = "Content-Type: image/jpeg"
zap = "--" & bound & vbCrLf & a1 & vbCrLf & a2 & vbCrLf & vbCrLf & vbCrLf & "--" & bound & "--"

HTTP.Open "POST", "https://m.avito.ru/add/image", False
HTTP.SetRequestHeader "content-type", "multipart/form-data; boundary=" & bound
HTTP.SetRequestHeader "referer", "https://m.avito.ru/add"
HTTP.SetRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/40.0.2214.93 Safari/537.36"
HTTP.SetRequestHeader "accept", "*/*"
HTTP.SetRequestHeader "accept-language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
HTTP.SetRequestHeader "origin", "https://m.avito.ru"

HTTP.Send zap
Text1.Text = HTTP.ResponseText


Чувствую что проблема на поверхности, но по своей неопытности не пойму в чём конкретно, подтолкните на путь истинный.
Запрос смотрел сниффером, если делать руками то ещё отправляется "content-length", но не пойму как он считается пробовал подсовывать:
Код: Выделить всё
HTTP.SetRequestHeader "Content-Length", FileLen("c:/avito/1.jpeg") + Len(zap)

не помогло.

В какую сторону копать?
Спасибо.

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 03.04.2015 (Пт) 13:14

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

VBS скрипт загрузки изображения на avito.ru
Код: Выделить всё
Option Explicit

'(Для корректной работы скрипта, в том же каталоге где и сам скрипт, должна лежать картинка "image.png")

'Константы для WinHttpRequest
Const WinHttpRequestOption_UserAgentString = 0
Const WinHttpRequestOption_URL = 1
Const WinHttpRequestOption_URLCodePage = 2

'Создаём объект для обмена по HTTP протоколу
Dim oHttpRequest
Set oHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
'Устанавливаем User-Agent, чтобы
oHttpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36"
'Если нужно авторизоваться на сайте, то вызываем процедуру авторизации,
'но, как выяснилось, для загрузки изображения в этом нет необходимости, так что авторизацию можем закомментировать.
'LoginAvito "login", "password"

'Запускаем процедуру загрузки изображения
UploadImage

'Процедура авторизации на авито
Sub LoginAvito(login, password)
    Dim oHtmlDoc
    Dim oHtmlForm
    'Загружаем страницу по нужному URL
    Set oHtmlDoc = documentFromURL(oHttpRequest,"https://m.avito.ru/profile/login")
    'Получаем форму
    Set oHtmlForm = oHtmlDoc.forms(0)
    'Заполняем поля логин и пароль
    oHtmlForm("login").value = login
    oHtmlForm("password").value = password
    'Эмулируем отправку формы   
    SubmitForm oHttpRequest, oHtmlForm
    'Если статус 200 нам не вернулся, значит не удалось нам пройти авторизацию
    if oHttpRequest.Status <> 200 Then
      Err.Raise vbObjectError + 1, "LoginAvito", "Авторизация не удалась. Сервер ответил статусом: " & oHttpRequest.status & " " & oHttpRequest.statusText
        'MsgBox "Не удалось авторизоваться на сервере", vbCritical
      Exit Sub
    End if

    'Факт авторизации мы можем проверить разными способами. Я решил проверить по фразе "Авторизация невозможна" в тексте страницы.
    if InStr(1,oHttpRequest.responseText,"Авторизация невозможна",vbTextCompare) > 0 Then
      Err.Raise vbObjectError + 2, "LoginAvito", "Авторизация не удалась. Неверный логин или пароль."
      Exit Sub
    End if

    MsgBox ParseHTML(oHttpRequest.ResponseText).body.outerText
End Sub

'Процедура загрузки изображения
Sub UploadImage()
    Dim sCurrentFolderPath
    Dim oRequestDataBuilder

    'Получаем текущий путь запуска
    sCurrentFolderPath = GetParentFolderPath(WScript.ScriptFullName)

    Set oRequestDataBuilder = new cRequestDataBuilder
    With oRequestDataBuilder
      .Url = "https://m.avito.ru/add/image"
      .AddFile "image[]", sCurrentFolderPath & "image.png", "image/png"
      .Method = "POST"
      .ContentType = "multipart/form-data"
        .Build
    End With
   
    'Отправляем запрос
    SubmitRequestData oHttpRequest, oRequestDataBuilder
   
    'Выводим в сообщение ответ сервера
    WScript.Echo oHttpRequest.responseText
End Sub

'Функция получения родительского пути
Function GetParentFolderPath(sPath)
   Dim p1, p2
    p1 = InStrRev(sPath,"\")
   p2 = InStrRev(sPath,"/")
   if p2 > p1 Then p1 = p2
   GetParentFolderPath = Left(sPath, p1)
End Function

'Функция загрузки HTML документа по указанному URL
Function documentFromURL(HttpRequest, Url)
    With HttpRequest
        .Open "GET", url, false
        .Send
        Set documentFromURL = parseHTML(.responseText)
    End With
End Function

'Функция разбора HTML кода. Возвращает HTML Document
Function parseHTML(data)
    Dim oHtmlDoc
    Set oHtmlDoc = CreateObject("htmlfile")
    With oHtmlDoc
        'Отключаем исполнение скриптов
        .designMode = "on"
        .write data
        .close
        'Отключаем загрузку ActiveX объектов
        .execCommand("stop")
    End With   
    Set parseHTML = oHtmlDoc
End Function

'Процедура эмуляции отправки формы
'(!) у поля <input type=file> нельзя считать значение value
'поэтому для указания нужного пути используется атрибут "filePath"
Sub SubmitForm(HttpRequest, HtmlForm)
   Dim oRequestDataBuilder
    Dim oElement
    Dim filePath
   Set oRequestDataBuilder = new cRequestDataBuilder
    With oRequestDataBuilder
      .Url = BuildURL(HttpRequest.Option(1), HtmlForm.Action)
       .Method = HtmlForm.Method
       .ContentType = HtmlForm.GetAttribute("enctype")
       For Each oElement in HTMLForm.Elements
            if oElement.Name <> "" Then
                if LCase(oElement.Type) = "file" Then
                    .AddFile oElement.Name, oElement.GetAttribute("filePath"), oElement.GetAttribute("contentType")
                Else
               .AddField oElement.Name, oElement.value
                End if
            End if
        Next
        SubmitRequestData HttpRequest, oRequestDataBuilder
   End With
End Sub

'Процедура отправки подготовленного запроса RequestDataBuilder
'(!) Предназначена для отправки данных, когда формы нет, а данные отправить нужно
Sub SubmitRequestData(HttpRequest, RequestDataBuilder)   
    With RequestDataBuilder      
       .Build
       HttpRequest.Open .Method, .Url, false
      
        'Задаём Referer. Так как иногда сайты его проверяют
       On Error Resume Next
       HttpRequest.SetRequestHeader "Referer", HttpRequest.Option(1)
       On Error Goto 0
      
       Select Case UCase(.Method)
       Case "GET"
         HttpRequest.Send
        Case "POST"
         HttpRequest.SetRequestHeader "Content-Type", .ContentType
         HttpRequest.Send .Body
       End Select
    End With
End Sub

'Функция построения URL от базового
'(!) Используется когда у ссылки или Action формы указан относительный адрес типа: "/data/post.php"
Function BuildURL(Href, Url)
    Dim oHtmlDoc, oBaseTag, oATag
    Set oHtmlDoc = CreateObject("htmlfile")
    oHtmlDoc.open
    With oHtmlDoc.createElement("base")
        .href = Href
        oHtmlDoc.write .outerHTML
    End With
    With oHtmlDoc.createElement("a")
        .href = Url
        oHtmlDoc.write .outerHTML
    End With
    oHtmlDoc.close
    BuildURL = oHtmlDoc.all.tags("a")(0).href
End Function

'Класс построения данных для отправки
Class cRequestDataBuilder
   'Свойство Url (r/w) - url на который будут отправлять данные
   Public Url
   'Свойство ContentType (r/w) - тип кодирования данных формы
   'application/x-www-form-urlencoded - отправка обычных текстовых полей формы
   'multipart/form-data - отправка полей и файлов
   'text/plain - отправка полей без кодирования
    '(!) Может содержать дополнительные параметры строки charset / boundary и т.п
   Public ContentType
   'Свойство Method (r/w) - Метод отправки данных (GET / POST)
   Public Method
   'Свойство HideFilePath (r/w) - Скрывать ли полные пути до файлов при отправке
   Public HideFilePath
   'Тело POST запроса
   Public Body

   Private oHtmlDoc, oScript, aItems
   
   'Событие инициализации класса
   Private Sub Class_Initialize()
      'Создаём объект htmlfile для того чтобы получить доступ к методу encodeURIComponent
      Set oHtmlDoc = CreateObject("htmlfile")
      Set oScript = oHtmlDoc.Script
      oScript.execScript("eval()")
      'Задаём URL по умолчанию
      Url = "about:blank"
      'Инициализируем массив полей
      aItems = Array()
      'Выставляем метод передачи по умолчанию
      Method = "GET"
        'Выставляем тип кодирования формы
      ContentType = "application/x-www-form-urlencoded"
      'По умолчанию скрываем пути до реальных файлов
      HideFilePath = True
   End Sub
   
   'Процедура добавления полей
   'Name - имя поля
   'Value - значение поля
   Public Sub AddField(Name, Value)
      AddItem Array(0, Name, Value)
   End Sub
   
   'Процедура добавления файлов   
   'Name - имя поля
   'FilePath - путь до файла
   'ContentType - тип файла (image/png | image/gif | application/binary и т.п.)
   Public Sub AddFile(Name, FilePath, ContentType)
      AddItem Array(1, Name, FilePath, ContentType)
   End Sub
   
   'Внутренняя процедура добавление элементов в коллекцию
   'aProperties - массив элементов
   Private Sub AddItem(aProperties)
      Dim lCount
      lCount = Ubound(aItems) + 1
      Redim Preserve aItems(lCount)
      aItems(lCount) = aProperties
   End Sub
   
   'Внутренняя функция построения строки аргументов из переданных значений
   Private Function BuildQueryString()
      Dim aItem, value
      With oScript
         'Перебираем все элементы массива aItems
         For Each aItem in aItems
            'Получаем значение поля
            value = aItem(2)
            'Если поле имеет тип 1, значит это файл. Обрезаем полный путь, если это требуется
            if aItem(0) = 1 and HideFilePath Then value = GetFileName(value)
            'Строим конечную строку
            BuildQueryString = BuildQueryString & "&" & .encodeURIComponent(aItem(1)) & "=" & .encodeURIComponent(value)
         Next
      End With
      'Отрезаем символ "&" в начале строки
      BuildQueryString = mid(BuildQueryString,2)
   End Function

    'Функция сбора строки заголовка из коллекции
    Private Function BuildHeader(Items)
        Dim sKey, sValue
        For Each sKey in Items.Keys
            sValue = Items(sKey)
            if sValue <> "" Then
                BuildHeader = BuildHeader & "; " & sKey & "=" & Items(sKey)   
            Else
                BuildHeader = BuildHeader & "; " & sKey   
            End if
        Next
        BuildHeader = mid(BuildHeader,3)
    End Function

    'Функция разбора параметров заголовка в коллекцию
    Private Function ParseHeader(Header)
        Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")
        Dim aGroups: aGroups = Split(Header,";")
        Dim Group, sValue
        oDict.CompareMode = vbTextCompare
        For Each Group in aGroups
            Group = Split(Group,"=",2)
            if Ubound(Group) = 1 Then sValue = Group(1)
            oDict(Trim(Group(0))) = Trim(sValue)
        Next
        Set ParseHeader = oDict
    End Function

   'Функция построения данных, возвращает данные подготовленные для отправки
   Public Sub Build()
      'Создаём префикс разделителей полей
      Const DefaultBoundary = "--"
      
      Body = Empty
      
      Dim sValue, aItem
      'Если метод отправки формы - GET
      Select Case UCase(Method)
      Case "GET"
         'Если нужно передать данные методом GET, то нам достаточно построить строку запроса
            if Ubound(aItems) > 0 Then
            lPos = InStr(1, Url, "?")
            If lPos > 0 Then Url = Left(Url, lPos - 1)
            Url = Url & "?" & BuildQueryString
         End if
      Case "POST"
            Dim aKeys, oParams
            'Разбираем ContentType
            Set oParams = ParseHeader(ContentType)
            'Получаем массив имён параметров
         aKeys = oParams.Keys
         'Проверяем, какой параметр идёт первым. Это должен быть тип кодирования
         Select Case LCase(aKeys(0))
         Case "application/x-www-form-urlencoded"
            Body = BuildQueryString()
         Case "multipart/form-data"
              'Константы режимов работы ADODB.Stream   
              Const adTypeBinary = 1
              Const adTypeText = 2
            Dim oStream, oFileStream, sContentType
                'Проверяем - есть ли среди параметров boundary            
                if Not oParams.Exists("boundary") Then oParams("boundary") = GenerateBoundary
                'Перестраиваем Content-Type с учётом boundary
                ContentType = BuildHeader(oParams)
            'Открываем Stream для записи формирования тела запроса
            Set oStream = CreateObject("ADODB.Stream")
                'Создаём Stream для чтения файлов
            Set oFileStream = CreateObject("ADODB.Stream")
                'Файловый стрим ставим в режим двоичного стения
            oFileStream.Type = adTypeBinary
            'Открываем стрим на запись в режиме текста
            With oStream
               .Type = adTypeText
               .Charset = "Windows-1251"
               .Open
               'Перебираем элементы массива
               For Each aItem in aItems
                  'Если это файла
                  if aItem(0) = 1 Then
                     'Если режим записи не текстовый, то переключаемся в текстовый
                     'if .Type <> adTypeText Then ChangeStreamType(adTypeText)
                     'Получаем ContentType поля
                     sContentType = aItem(3)
                     'Если ContentType не указан, то указываем его сами
                     if Len(sContentType) <= 0 Then sContentType = "application/octet-stream"
                     'Получаем значение поля - путь до файла
                     sValue = aItem(2)
                     'Если нужно скрывать пути, оставляем только имя файла
                     if HideFilePath Then sValue = GetFileName(sValue)
                     'Дописываем в стрим заголовок
                     .WriteText DefaultBoundary & oParams("boundary") & vbCrlf &_
                              "Content-Disposition: form-data; name=""" & aItem(1) & """; filename=""" & sValue & """" & vbCrlf &_
                              "Content-Type: " & sContentType & vbCrlf & vbCrlf

                     'Переключаем стрим в двоичный режим записи
                     ChangeStreamType oStream, adTypeBinary
                     'Загружаем тело файла
                     With oFileStream
                        .Open
                        .LoadFromFile aItem(2)
                        'Записываем в поток тело
                        oStream.Write oFileStream.Read
                        .Close
                     End With
                     'Возвращаем стрим в текстовый режим
                     ChangeStreamType oStream, adTypeText
                     'Дописываем перевод строки
                     .WriteText vbCrlf
                  Else
                     'if .Type <> adTypeText Then ChangeStreamType(adTypeText)
                     .WriteText DefaultBoundary & oParams("boundary") & vbCrlf &_
                              "Content-Disposition: form-data; name=""" & aItem(1) & """" & vbCrlf & vbCrlf & aItem(2) & vbCrlf
                  End If
               Next
               'В конец дописываем "--BOUNDARY_VALUE--"
               .WriteText DefaultBoundary & oParams("boundary") & DefaultBoundary
               'Меняем тип стрима обратно на двоичный и выставляем курсор на начало данных
               .Position = 0
               .Type = adTypeBinary
               'Сохраняем Body в результат
               Body = .Read
               .Close
            End With
         Case "text/plain"
            Dim sData
                For Each aItem in aItems
               sValue = aItem(2)
               If aItem(0) = 1 And HideFilePath Then sValue = GetFileName(sValue)
               sData = sData & vbCrlf & aItem(1) & "=" & sValue
            Next
            Body = Replace(mid(sData,2)," ","+")
         Case Else
            Err.Raise vbObjectError + 2, TypeName(Me), "Unknown enctype"
         End Select
      Case Else
         Err.Raise vbObjectError + 3, TypeName(Me), "Unknown request method"
      End Select
   End Sub
   
   'Процедура изменения режима работы стрима ( текстовый / двоичный )
   Private Sub ChangeStreamType(oStream, StreamType)
      Dim lPos
      With oStream
         'Запоминаем текущую позицию стрима
         lPos = .Position
         'возвращаемся на начало и меняем тип стрима
         .Position = 0
         .Type = StreamType
         'Возвращаемся на нужную позицию
         .Position = lPos
      End With
   End Sub
   
   'Функция построения boundary
   Private Function GenerateBoundary()
      Const Chars = "abcdefghijklmopqrstuvwxyz0123456789"
      Dim i, r, c
      Randomize
      GenerateBoundary = String("27","-")
      For i = 1 to 13
         r = Int(len(Chars) * Rnd + 1)
         c = Mid(Chars,r,1)
         if r mod 2 Then c = UCase(c)
         GenerateBoundary = GenerateBoundary & c
      Next
   End Function
   
   'Функция получения имени файла из пути
    '(можно было бы использовать RegExp, но я слаб в регулярках)
   Private Function GetFileName(FilePath)
      Dim p1, p2
      p1 = InStrRev(FilePath,"\")
      p2 = InStrRev(FilePath,"/")
      if p2 > p1 Then p1 = p2
      GetFileName = mid(FilePath,p1+1)
   End Function
End Class


P.S Постарался все комментарии расписать.

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 06.04.2015 (Пн) 13:59

Огромное тебе спасибо!!
Всё оказалось много проще чем я думал.

Вопрос закрыт

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 06.04.2015 (Пн) 14:48

Рад, что пригодилось. Если будут вопросы в этом направлении - сообщайте. :wink:

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.04.2015 (Вт) 14:09

ALX_2002 писал(а):Рад, что пригодилось. Если будут вопросы в этом направлении - сообщайте. :wink:


С картинками разобрался, скрипт загружает их без проблем, а вот логиниться и отправлять форму с прикреплённой картинкой так и не получилось, пишет "Bad request"

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 14.04.2015 (Вт) 16:03

А на код взглянуть можно, если не секрет ?

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.04.2015 (Вт) 16:14

Не получается залогинится и отправить форму твоим скриптом.
Я логинюсь так:
Код: Выделить всё
Http.Open "POST", "https://m.avito.ru/profile/login", False 'Replace LINK with the php page who will get data .
Http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/40.0.2214.93 Safari/537.36"
Http.SetRequestHeader "Accept-Charset", "UTF-8"
Http.SetRequestHeader "Cache-Control", "max-age=0"
Http.SetRequestHeader "Keep-Alive", "300"
Http.SetRequestHeader "Connection", "Keep-Alive"
Http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Http.SetRequestHeader "location", "/profile"
Http.SetRequestHeader "origin", "https://m.avito.ru"
Http.SetRequestHeader "referer", "https://m.avito.ru/profile/login"

Http.Send "login=login&password=pass&next=%2Fprofile"

Text1.Text = Http.ResponseText
coc = Http.GetResponseHeader("Set-Cookie")


Всё проходит хорошо, далее перехожу на добавление объявления, забираю капчу и токен, дальше отправляю объяву:
Код: Выделить всё
Http.Open "POST", "https://m.avito.ru/add", False 'Replace LINK with the php page who will get data .
Http.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/40.0.2214.93 Safari/537.36"
Http.SetRequestHeader "Accept-Charset", "UTF-8"
Http.SetRequestHeader "Cache-Control", "max-age=0"
Http.SetRequestHeader "Keep-Alive", "300"
Http.SetRequestHeader "Connection", "Keep-Alive"
Http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Http.SetRequestHeader "origin", "https://m.avito.ru"
Http.SetRequestHeader "referer", "https://m.avito.ru/add"

Http.Send "category_id=101" _
& "&params[483]=" _
& "&params[631]=" _
& "&title=" _
& "&description=" _
& "&price=3500" _
& "&region_id=" _
& "&location_id=" _
& "&seller_name=NAME" _
& "&email=MAIL" _
& "&location_id=" _
& "&phone=8 XXXX" _
& "&allow_mails=1" _
& "&" & tokenname & "=" & token & "" _
& "&captcha=" & img_cap

Text1.Text = Http.ResponseText


Затем выбор что объявление бесплатное и всё, объявление добавлено.

Не получается загруженную картинку прикрепить к объявлению

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 14.04.2015 (Вт) 16:29

kifiro писал(а):Я логинюсь так:

Не сработает, если там был редирект и http запрос обработал его самостоятельно.
Возможно, надо отключать.


kifiro писал(а):Всё проходит хорошо

Ты же выше говорил, что с логином проблемы?

kifiro писал(а):Не получается загруженную картинку прикрепить к объявлению

Там multipart/formdata надо слать, скорее всего.
Бери Fiddler и сравнивай, что шлёт сайт и что шлёшь ты.

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 14.04.2015 (Вт) 16:30

kifiro, :shock: Не похоже на "мой" скрипт. ) У меня для начала загружается тело страницы, дальше парсится и преобразуется в объектную модель HTML DOM. Далее заполняются необходимые поля формы и форма скармливается процедуре SubmitForm. В Вашем коде я подобного не наблюдаю. :D

P.S Более того. В моём примере уже есть готовая процедура авторизации. Почему не хотите её использовать ? Есть неудобства ?

Qwertiy, зачем Fiddler ? Ведь IE и Chrome и FireFox честно показывают свои отправляемые данные ? :shock:

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.04.2015 (Вт) 16:34

ALX_2002 писал(а):kifiro, :shock: Не похоже на "мой" скрипт. ) У меня для начала загружается тело страницы, дальше парсится и преобразуется в объектную модель HTML DOM. Далее заполняются необходимые поля формы и форма скармливается процедуре SubmitForm. В Вашем коде я подобного не наблюдаю. :D

Qwertiy, зачем Fiddler ? Ведь IE и Chrome и FireFox честно показывают свои отправляемые данные ? :shock:


Ну твой код прикреплять не стал, т.к. ты его выше сам прикрепил :)

Вызываю
Код: Выделить всё
LoginAvito "login", "password"
в ответ получаю "Bad request".

Как переносил твой код, добавил новый класс cRequestDataBuilder, всё остальное на форму, может накосячил на этом этапе?
Код: Выделить всё
   'Свойство Url (r/w) - url на который будут отправлять данные
   Public Url
   'Свойство ContentType (r/w) - тип кодирования данных формы
   'application/x-www-form-urlencoded - отправка обычных текстовых полей формы
   'multipart/form-data - отправка полей и файлов
   'text/plain - отправка полей без кодирования
    '(!) Может содержать дополнительные параметры строки charset / boundary и т.п
   Public ContentType
   'Свойство Method (r/w) - Метод отправки данных (GET / POST)
   Public Method
   'Свойство HideFilePath (r/w) - Скрывать ли полные пути до файлов при отправке
   Public HideFilePath
   'Тело POST запроса
   Public Body

   Private oHtmlDoc, oScript, aItems
   
   'Событие инициализации класса
   Private Sub Class_Initialize()
      'Создаём объект htmlfile для того чтобы получить доступ к методу encodeURIComponent
      Set oHtmlDoc = CreateObject("htmlfile")
      Set oScript = oHtmlDoc.Script
      oScript.execScript("eval()")
      'Задаём URL по умолчанию
      Url = "about:blank"
      'Инициализируем массив полей
      aItems = Array()
      'Выставляем метод передачи по умолчанию
      Method = "GET"
        'Выставляем тип кодирования формы
      ContentType = "application/x-www-form-urlencoded"
      'По умолчанию скрываем пути до реальных файлов
      HideFilePath = True
   End Sub
   
   'Процедура добавления полей
   'Name - имя поля
   'Value - значение поля
   Public Sub AddField(Name, Value)
      AddItem Array(0, Name, Value)
   End Sub
   
   'Процедура добавления файлов   
   'Name - имя поля
   'FilePath - путь до файла
   'ContentType - тип файла (image/png | image/gif | application/binary и т.п.)
   Public Sub AddFile(Name, FilePath, ContentType)
      AddItem Array(1, Name, FilePath, ContentType)
   End Sub
   
   'Внутренняя процедура добавление элементов в коллекцию
   'aProperties - массив элементов
   Private Sub AddItem(aProperties)
      Dim lCount
      lCount = Ubound(aItems) + 1
      Redim Preserve aItems(lCount)
      aItems(lCount) = aProperties
   End Sub
   
   'Внутренняя функция построения строки аргументов из переданных значений
   Private Function BuildQueryString()
      Dim aItem, value
      With oScript
         'Перебираем все элементы массива aItems
         For Each aItem in aItems
            'Получаем значение поля
            value = aItem(2)
            'Если поле имеет тип 1, значит это файл. Обрезаем полный путь, если это требуется
            if aItem(0) = 1 and HideFilePath Then value = GetFileName(value)
            'Строим конечную строку
            BuildQueryString = BuildQueryString & "&" & .encodeURIComponent(aItem(1)) & "=" & .encodeURIComponent(value)
         Next
      End With
      'Отрезаем символ "&" в начале строки
      BuildQueryString = mid(BuildQueryString,2)
   End Function

    'Функция сбора строки заголовка из коллекции
    Private Function BuildHeader(Items)
        Dim sKey, sValue
        For Each sKey in Items.Keys
            sValue = Items(sKey)
            if sValue <> "" Then
                BuildHeader = BuildHeader & "; " & sKey & "=" & Items(sKey)   
            Else
                BuildHeader = BuildHeader & "; " & sKey   
            End if
        Next
        BuildHeader = mid(BuildHeader,3)
    End Function

    'Функция разбора параметров заголовка в коллекцию
    Private Function ParseHeader(Header)
        Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")
        Dim aGroups: aGroups = Split(Header,";")
        Dim Group, sValue
        oDict.CompareMode = vbTextCompare
        For Each Group in aGroups
            Group = Split(Group,"=",2)
            if Ubound(Group) = 1 Then sValue = Group(1)
            oDict(Trim(Group(0))) = Trim(sValue)
        Next
        Set ParseHeader = oDict
    End Function

   'Функция построения данных, возвращает данные подготовленные для отправки
   Public Sub Build()
      'Создаём префикс разделителей полей
      Const DefaultBoundary = "--"
     
      Body = Empty
     
      Dim sValue, aItem
      'Если метод отправки формы - GET
      Select Case UCase(Method)
      Case "GET"
         'Если нужно передать данные методом GET, то нам достаточно построить строку запроса
            if Ubound(aItems) > 0 Then
            lPos = InStr(1, Url, "?")
            If lPos > 0 Then Url = Left(Url, lPos - 1)
            Url = Url & "?" & BuildQueryString
         End if
      Case "POST"
            Dim aKeys, oParams
            'Разбираем ContentType
            Set oParams = ParseHeader(ContentType)
            'Получаем массив имён параметров
         aKeys = oParams.Keys
         'Проверяем, какой параметр идёт первым. Это должен быть тип кодирования
         Select Case LCase(aKeys(0))
         Case "application/x-www-form-urlencoded"
            Body = BuildQueryString()
         Case "multipart/form-data"
              'Константы режимов работы ADODB.Stream   
              Const adTypeBinary = 1
              Const adTypeText = 2
            Dim oStream, oFileStream, sContentType
                'Проверяем - есть ли среди параметров boundary           
                if Not oParams.Exists("boundary") Then oParams("boundary") = GenerateBoundary
                'Перестраиваем Content-Type с учётом boundary
                ContentType = BuildHeader(oParams)
            'Открываем Stream для записи формирования тела запроса
            Set oStream = CreateObject("ADODB.Stream")
                'Создаём Stream для чтения файлов
            Set oFileStream = CreateObject("ADODB.Stream")
                'Файловый стрим ставим в режим двоичного стения
            oFileStream.Type = adTypeBinary
            'Открываем стрим на запись в режиме текста
            With oStream
               .Type = adTypeText
               .Charset = "Windows-1251"
               .Open
               'Перебираем элементы массива
               For Each aItem in aItems
                  'Если это файла
                  if aItem(0) = 1 Then
                     'Если режим записи не текстовый, то переключаемся в текстовый
                     'if .Type <> adTypeText Then ChangeStreamType(adTypeText)
                     'Получаем ContentType поля
                     sContentType = aItem(3)
                     'Если ContentType не указан, то указываем его сами
                     if Len(sContentType) <= 0 Then sContentType = "application/octet-stream"
                     'Получаем значение поля - путь до файла
                     sValue = aItem(2)
                     'Если нужно скрывать пути, оставляем только имя файла
                     if HideFilePath Then sValue = GetFileName(sValue)
                     'Дописываем в стрим заголовок
                     .WriteText DefaultBoundary & oParams("boundary") & vbCrlf &_
                              "Content-Disposition: form-data; name=""" & aItem(1) & """; filename=""" & sValue & """" & vbCrlf &_
                              "Content-Type: " & sContentType & vbCrlf & vbCrlf

                     'Переключаем стрим в двоичный режим записи
                     ChangeStreamType oStream, adTypeBinary
                     'Загружаем тело файла
                     With oFileStream
                        .Open
                        .LoadFromFile aItem(2)
                        'Записываем в поток тело
                        oStream.Write oFileStream.Read
                        .Close
                     End With
                     'Возвращаем стрим в текстовый режим
                     ChangeStreamType oStream, adTypeText
                     'Дописываем перевод строки
                     .WriteText vbCrlf
                  Else
                     'if .Type <> adTypeText Then ChangeStreamType(adTypeText)
                     .WriteText DefaultBoundary & oParams("boundary") & vbCrlf &_
                              "Content-Disposition: form-data; name=""" & aItem(1) & """" & vbCrlf & vbCrlf & aItem(2) & vbCrlf
                  End If
               Next
               'В конец дописываем "--BOUNDARY_VALUE--"
               .WriteText DefaultBoundary & oParams("boundary") & DefaultBoundary
               'Меняем тип стрима обратно на двоичный и выставляем курсор на начало данных
               .Position = 0
               .Type = adTypeBinary
               'Сохраняем Body в результат
               Body = .Read
               .Close
            End With
         Case "text/plain"
            Dim sData
                For Each aItem in aItems
               sValue = aItem(2)
               If aItem(0) = 1 And HideFilePath Then sValue = GetFileName(sValue)
               sData = sData & vbCrlf & aItem(1) & "=" & sValue
            Next
            Body = Replace(mid(sData,2)," ","+")
         Case Else
            Err.Raise vbObjectError + 2, TypeName(Me), "Unknown enctype"
         End Select
      Case Else
         Err.Raise vbObjectError + 3, TypeName(Me), "Unknown request method"
      End Select
   End Sub
   
   'Процедура изменения режима работы стрима ( текстовый / двоичный )
   Private Sub ChangeStreamType(oStream, StreamType)
      Dim lPos
      With oStream
         'Запоминаем текущую позицию стрима
         lPos = .Position
         'возвращаемся на начало и меняем тип стрима
         .Position = 0
         .Type = StreamType
         'Возвращаемся на нужную позицию
         .Position = lPos
      End With
   End Sub
   
   'Функция построения boundary
   Private Function GenerateBoundary()
      Const Chars = "abcdefghijklmopqrstuvwxyz0123456789"
      Dim i, r, c
      Randomize
      GenerateBoundary = String("27","-")
      For i = 1 to 13
         r = Int(len(Chars) * Rnd + 1)
         c = Mid(Chars,r,1)
         if r mod 2 Then c = UCase(c)
         GenerateBoundary = GenerateBoundary & c
      Next
   End Function
   
   'Функция получения имени файла из пути
    '(можно было бы использовать RegExp, но я слаб в регулярках)
   Private Function GetFileName(FilePath)
      Dim p1, p2
      p1 = InStrRev(FilePath,"\")
      p2 = InStrRev(FilePath,"/")
      if p2 > p1 Then p1 = p2
      GetFileName = mid(FilePath,p1+1)
   End Function

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 14.04.2015 (Вт) 16:40

ALX_2002 писал(а):зачем Fiddler ? Ведь IE и Chrome и FireFox честно показывают свои отправляемые данные ? :shock:

Во-первых, в Fiddler'е удобнее. Во-вторых, там можно редактировать запросы, отправлять их и смотреть результат. Ну и наконец, он ещё и покажет, что же ты сам-то шлёшь.

Т. е. общая схема примерно такая:
1. Посмотреть, что шлёт браузер.
2. Выкидывать лишнее, проверяя, что ответ всё ещё нормальный.
3. Посмотреть, что шлёшь сам. Попытаться дополнить запрос. Привести его к правильному.
4. Изменить код, чтобы посылаемый запрос совпадал с требуемым.

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re:

Сообщение kifiro » 14.04.2015 (Вт) 16:44

Qwertiy писал(а):
ALX_2002 писал(а):зачем Fiddler ? Ведь IE и Chrome и FireFox честно показывают свои отправляемые данные ? :shock:

Во-первых, в Fiddler'е удобнее. Во-вторых, там можно редактировать запросы, отправлять их и смотреть результат. Ну и наконец, он ещё и покажет, что же ты сам-то шлёшь.

Т. е. общая схема примерно такая:
1. Посмотреть, что шлёт браузер.
2. Выкидывать лишнее, проверяя, что ответ всё ещё нормальный.
3. Посмотреть, что шлёшь сам. Попытаться дополнить запрос. Привести его к правильному.
4. Изменить код, чтобы посылаемый запрос совпадал с требуемым.


Спасибо за наводку, сейчас проверю что шлю я

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 14.04.2015 (Вт) 16:45

kifiro писал(а):Ну твой код прикреплять не стал, т.к. ты его выше сам прикрепил :)


Правильно. И не надо его прикреплять. Меня смутило не это, а то что Вы снова пытаетесь собирать данные для отправки вручную. :shock:

Я вот об этом:
Код: Выделить всё
....
Set HTTP = New WinHttp.WinHttpRequest
bound = "----WebKitFormBoundaryMgS2xkEu1AflNCeY"
a1 = "Content-Disposition: form-data; name=image[]; filename=c:\avito\1.jpeg"
a2 = "Content-Type: image/jpeg"
zap = "--" & bound & vbCrLf & a1 & vbCrLf & a2 & vbCrLf & vbCrLf & vbCrLf & "--" & bound & "--"

HTTP.Open "POST", "https://m.avito.ru/add/image", False
HTTP.SetRequestHeader "content-type", "multipart/form-data; boundary=" & bound
HTTP.SetRequestHeader "referer", "https://m.avito.ru/add"
HTTP.SetRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/40.0.2214.93 Safari/537.36"
HTTP.SetRequestHeader "accept", "*/*"
......


Зачем ? Если есть уже готовый класс cRequestDataBuilder и методы для отправки форм ?

kifiro писал(а):Вызываю
Код: Выделить всё
LoginAvito "login", "password"
в ответ получаю "Bad request".

Логин и пароль правильный используете :?:

Только что проверил под своей учётной записью - получаю список своих объявлений.

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.04.2015 (Вт) 17:08

Логин и пароль правильный проверил.
Если работает у Вас, то как я понимаю, не правильно его перенёс в vb6/


Вот полный код формы:
Код: Выделить всё
Option Explicit
Dim oHttpRequest

'Константы для WinHttpRequest
Const WinHttpRequestOption_UserAgentString = 0
Const WinHttpRequestOption_URL = 1
Const WinHttpRequestOption_URLCodePage = 2

Sub LoginAvito(login, password)
    Dim oHtmlDoc
    Dim oHtmlForm
    'Загружаем страницу по нужному URL
    Set oHtmlDoc = documentFromURL(oHttpRequest, "https://m.avito.ru/profile/login")
    'Получаем форму
    Set oHtmlForm = oHtmlDoc.Forms(0)
    'Заполняем поля логин и пароль
    oHtmlForm("login").value = login
    oHtmlForm("password").value = password
    'Эмулируем отправку формы
    SubmitForm oHttpRequest, oHtmlForm
    'Если статус 200 нам не вернулся, значит не удалось нам пройти авторизацию
    If oHttpRequest.Status <> 200 Then
      Err.Raise vbObjectError + 1, "LoginAvito", "Авторизация не удалась. Сервер ответил статусом: " & oHttpRequest.Status & " " & oHttpRequest.statusText
        'MsgBox "Не удалось авторизоваться на сервере", vbCritical
      Exit Sub
    End If

    'Факт авторизации мы можем проверить разными способами. Я решил проверить по фразе "Авторизация невозможна" в тексте страницы.
    If InStr(1, oHttpRequest.responseText, "Авторизация невозможна", vbTextCompare) > 0 Then
      Err.Raise vbObjectError + 2, "LoginAvito", "Авторизация не удалась. Неверный логин или пароль."
      Exit Sub
    End If

    MsgBox parseHTML(oHttpRequest.responseText).Body.outerText
End Sub

'Процедура загрузки изображения
Sub UploadImage()
    Dim sCurrentFolderPath
    Dim oRequestDataBuilder

    'Получаем текущий путь запуска
    sCurrentFolderPath = GetParentFolderPath(WScript.ScriptFullName)

    Set oRequestDataBuilder = New cRequestDataBuilder
    With oRequestDataBuilder
      .Url = "https://m.avito.ru/add/image"
      .AddFile "image[]", sCurrentFolderPath & "image.png", "image/png"
      .Method = "POST"
      .ContentType = "multipart/form-data"
        .Build
    End With
   
    'Отправляем запрос
    SubmitRequestData oHttpRequest, oRequestDataBuilder
   
    'Выводим в сообщение ответ сервера
    WScript.Echo oHttpRequest.responseText
End Sub

'Функция получения родительского пути
Function GetParentFolderPath(sPath)
   Dim p1, p2
    p1 = InStrRev(sPath, "\")
   p2 = InStrRev(sPath, "/")
   If p2 > p1 Then p1 = p2
   GetParentFolderPath = Left(sPath, p1)
End Function

'Функция загрузки HTML документа по указанному URL
Function documentFromURL(HttpRequest, Url)
    With HttpRequest
        .Open "GET", Url, False
        .Send
        Set documentFromURL = parseHTML(.responseText)
    End With
End Function

'Функция разбора HTML кода. Возвращает HTML Document
Function parseHTML(data)
    Dim oHtmlDoc
    Set oHtmlDoc = CreateObject("htmlfile")
    With oHtmlDoc
        'Отключаем исполнение скриптов
        .designMode = "on"
        .Write data
        .Close
        'Отключаем загрузку ActiveX объектов
        .execCommand ("stop")
    End With
    Set parseHTML = oHtmlDoc
End Function

'Процедура эмуляции отправки формы
'(!) у поля <input type=file> нельзя считать значение value
'поэтому для указания нужного пути используется атрибут "filePath"
Sub SubmitForm(HttpRequest, HtmlForm)
   Dim oRequestDataBuilder
    Dim oElement
    Dim FilePath
   Set oRequestDataBuilder = New cRequestDataBuilder
    With oRequestDataBuilder
      .Url = BuildURL(HttpRequest.Option(1), HtmlForm.Action)
       .Method = HtmlForm.Method
       .ContentType = HtmlForm.GetAttribute("enctype")
       For Each oElement In HtmlForm.Elements
            If oElement.Name <> "" Then
                If LCase(oElement.Type) = "file" Then
                    .AddFile oElement.Name, oElement.GetAttribute("filePath"), oElement.GetAttribute("contentType")
                Else
               .AddField oElement.Name, oElement.value
                End If
            End If
        Next
        SubmitRequestData HttpRequest, oRequestDataBuilder
   End With
End Sub

'Процедура отправки подготовленного запроса RequestDataBuilder
'(!) Предназначена для отправки данных, когда формы нет, а данные отправить нужно
Sub SubmitRequestData(HttpRequest, RequestDataBuilder)
    With RequestDataBuilder
       .Build
       HttpRequest.Open .Method, .Url, False
       
        'Задаём Referer. Так как иногда сайты его проверяют
       On Error Resume Next
       HttpRequest.SetRequestHeader "Referer", HttpRequest.Option(1)
       On Error GoTo 0
       
       Select Case UCase(.Method)
       Case "GET"
         HttpRequest.Send
        Case "POST"
         HttpRequest.SetRequestHeader "Content-Type", .ContentType
         HttpRequest.Send .Body
       End Select
    End With
End Sub

'Функция построения URL от базового
'(!) Используется когда у ссылки или Action формы указан относительный адрес типа: "/data/post.php"
Function BuildURL(Href, Url)
    Dim oHtmlDoc, oBaseTag, oATag
    Set oHtmlDoc = CreateObject("htmlfile")
    oHtmlDoc.Open
    With oHtmlDoc.createElement("base")
        .Href = Href
        oHtmlDoc.Write .outerHTML
    End With
    With oHtmlDoc.createElement("a")
        .Href = Url
        oHtmlDoc.Write .outerHTML
    End With
    oHtmlDoc.Close
    BuildURL = oHtmlDoc.All.tags("a")(0).Href
End Function

Private Sub Command1_Click()
LoginAvito "theqdd2@gmail.com", "XXX"
End Sub

Private Sub Form_Load()
Set oHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
oHttpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36"
End Sub



Жму command1,
"Авторизация не удалась, сервер ответил статусом: 400 Bad request .."
Последний раз редактировалось kifiro 14.04.2015 (Вт) 18:06, всего редактировалось 1 раз.

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 14.04.2015 (Вт) 17:30

kifiro. Собрал проект. У меня всё работает. :|

Правда не совсем понимаю, для чего Вам именно WinHttpRequest в этом случае. Можно было бы обойтись обычным WebBrowser-ом. В нём всё это гораздо проще решается.
Вложения
AVITO.zip
(6.92 Кб) Скачиваний: 265
1.jpg
1.jpg (206.04 Кб) Просмотров: 14863

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.04.2015 (Вт) 18:13

Видимо проблема на моей стороне, т.к. и с Вашей сборкой залогинится не могу :D Всё также "Bad request"

C WinHttpRequest начал заморачиваться из-за того что, так и не разобрался как webbrowser'ом загружать и прикреплять картинки к объявлению) Думал что с помощью WinHttp будет легче разобраться.

Спасибо за поддержку.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 14.04.2015 (Вт) 18:20

Эх.. Повторяется история, только теперь на VB6 :D

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re:

Сообщение ALX_2002 » 14.04.2015 (Вт) 19:07

Qwertiy,
Qwertiy писал(а):Эх.. Повторяется история, только теперь на VB6 :D

О ! Будем почитать в чём там дело было. )

kifiro,
kifiro писал(а):C WinHttpRequest начал заморачиваться из-за того что, так и не разобрался как webbrowser'ом загружать и прикреплять картинки к объявлению) Думал что с помощью WinHttp будет легче разобраться.

попробую собрать с учётом WebBrowser. :wink:

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: winhttp отправка файлов

Сообщение ALX_2002 » 15.04.2015 (Ср) 17:37

kifiro, начал собирать проект на WebBrowser-е.
1) Авторизацию сделал.
2) Выход из профиля сделал.
3) Получение капчи в Image на форму из WebBrowser сделал

И тут возник вопрос - До какой степени нужно выполнять действия за пользователя ?
С капчей всё понятно - её должен пользователь ввести. А остальные поля объявления должны автоматически сами заполниться или их надо тоже на форме пользователю показать, чтобы он сам их заполнил ?

P.S То что получилось - прикладываю к сообщению
Вложения
prjAvito.zip
(5.39 Кб) Скачиваний: 204

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 16.04.2015 (Чт) 11:03

ALX_2002 писал(а):kifiro, начал собирать проект на WebBrowser-е.
1) Авторизацию сделал.
2) Выход из профиля сделал.
3) Получение капчи в Image на форму из WebBrowser сделал

И тут возник вопрос - До какой степени нужно выполнять действия за пользователя ?
С капчей всё понятно - её должен пользователь ввести. А остальные поля объявления должны автоматически сами заполниться или их надо тоже на форме пользователю показать, чтобы он сам их заполнил ?

P.S То что получилось - прикладываю к сообщению


Огромное тебе спасибо за труды!

Да по большому счёту без разницы как заполнять, сам допилить смогу, самое главное чтобы картинка загрузилась, и прикрепилась к объяве

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 06.05.2015 (Ср) 11:37

ALX_2002
Прошу прощения за назойливость)
Но возникла старая проблема с загрузкой и последующим прикреплением их к объявлению

По твоему коду, для добавления картинки, получаем окно с ручным выбором картинки, а хотелось бы что-бы картинка сама прикреплялась.
В идеале должно выглядеть так, я захожу на страницу добавления объявления, сам заполняю поля заголовок и описание, вписываю капчу и т.д., а картинки сами грузились и прикреплялись, без моего участия, сообственно поэтому и начал юзать winhttprequest, т.к. понимаю что через формы кроме как руками картинку прикрепить не получится, или я ошибаюсь и есть какие-то решения?

И я чувствую что близок к истине с загрузкой через пост запрос, но никак не могу понять что не так(
Код: Выделить всё
Http.Open "POST", "https://m.avito.ru/add/image", False 'Replace LINK with the php page who will get data .

Http.SetRequestHeader "Host", "m.avito.ru"
Http.SetRequestHeader "Connection", "Keep-Alive"
Http.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)"
Http.SetRequestHeader "Accept", "*/*"
Http.SetRequestHeader "Content-Type", "multipart/form-data; boundary=---------------------------hqR01E4Xhq9G3"
Http.SetRequestHeader "referer", "https://m.avito.ru/add/image"

Http.Send "-----------------------------hqR01E4Xhq9G3" & vbCrLf & "Content-Disposition: form-data; name=" & Chr(34) & "image[]" & Chr(34) & "; filename=" & Chr(34) & "c:\1.jpg" & Chr(34) & "" & vbCrLf & "Content-Type: image/png" & vbCrLf & vbCrLf & vbCrLf & "-----------------------------hqR01E4Xhq9G3--"


Смотрел через парсер, получается что:
Браузером:
Код: Выделить всё
-----------------------------h10s5sMEws74I
Content-Disposition: form-data; name="image[]"; filename="1.jpg"
Content-Type: image/png

"тут всякие крякозябры как я понимаю картинка в каком-то формате"

-----------------------------h10s5sMEws74I--


моим запросом:
Код: Выделить всё
-----------------------------hqR01E4Xhq9G3
Content-Disposition: form-data; name="image[]"; filename="c:\1.jpg"
Content-Type: image/png


-----------------------------hqR01E4Xhq9G3--

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 07.05.2015 (Чт) 19:10

kifiro писал(а):"тут всякие крякозябры как я понимаю картинка в каком-то формате"

Вероятно, это твой файл побайтово.

kifiro писал(а):
Код: Выделить всё
-----------------------------h10s5sMEws74I--

Если не ошибаюсь, там ещё пара переводов строки должна быть. В любом случае, обрати на конец внимание.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: winhttp отправка файлов

Сообщение Хакер » 07.05.2015 (Чт) 19:11

Qwertiy писал(а):Вероятно, это твой файл побайтово.

Не побайтово, а в base64-же.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 07.05.2015 (Чт) 19:23

Хакер писал(а):Не побайтово, а в base64-же.

Нет, именно побайтово.
http://jsfiddle.net/ntc430bn/

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 08.05.2015 (Пт) 15:41

А подскажите может, что нужно дописать что бы ещё и файл побайтово отправлялся?

Код: Выделить всё
Http.Open "POST", "https://m.avito.ru/add/image", False 'Replace LINK with the php page who will get data .

Http.SetRequestHeader "Host", "m.avito.ru"
Http.SetRequestHeader "Connection", "Keep-Alive"
Http.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)"
Http.SetRequestHeader "Accept", "*/*"
Http.SetRequestHeader "Content-Type", "multipart/form-data; boundary=---------------------------hqR01E4Xhq9G3"
Http.SetRequestHeader "referer", "https://m.avito.ru/add/image"

Http.Send "-----------------------------hqR01E4Xhq9G3" & vbCrLf & "Content-Disposition: form-data; name=" & Chr(34) & "image[]" & Chr(34) & "; filename=" & Chr(34) & "c:\1.jpg" & Chr(34) & "" & vbCrLf & "Content-Type: image/png" & vbCrLf & vbCrLf & vbCrLf & "-----------------------------hqR01E4Xhq9G3--"
Последний раз редактировалось kifiro 14.05.2015 (Чт) 15:37, всего редактировалось 1 раз.

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: winhttp отправка файлов

Сообщение Хакер » 08.05.2015 (Пт) 17:44

  1. Тут надо не дописать, а выкинуть эту гадость и написать нормальный код. Ты по прежнему не шлёшь контент файла, зато шлёшь полное имя файла (что настолько неправильно, что даже дерзко).
  2. Зачем ты используешь тег [quote], там, где нужно использовать тег [code]? Оформляй посты правильно, или будешь наказан.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 08.05.2015 (Пт) 19:31

3. Перевод строки в конце тоже куда-то потерялся.
4. Что за шикарный user agent?

kifiro
Начинающий
Начинающий
 
Сообщения: 22
Зарегистрирован: 06.09.2008 (Сб) 18:57

Re: winhttp отправка файлов

Сообщение kifiro » 14.05.2015 (Чт) 15:39

Хакер писал(а):
  1. Тут надо не дописать, а выкинуть эту гадость и написать нормальный код. Ты по прежнему не шлёшь контент файла, зато шлёшь полное имя файла (что настолько неправильно, что даже дерзко).
  2. Зачем ты используешь тег
    , там, где нужно использовать тег [code]? Оформляй посты правильно, или будешь наказан.


1) Я понимаю что шлю имя файла, в этом и вопрос, как отправить именно контент файла
2) Замечание понял, буду внимательнее

Qwertiy писал(а):3. Перевод строки в конце тоже куда-то потерялся.
4. Что за шикарный user agent?


3) Перевод добавил, спасибо
4) Такой юзер агент при отправке картинки с помощью класса ALX_2002

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: winhttp отправка файлов

Сообщение Хакер » 14.05.2015 (Чт) 22:43

kifiro писал(а):1) Я понимаю что шлю имя файла, в этом и вопрос, как отправить именно контент файла

Не могу удержаться от ответа «очень просто». В чём проблема? Разбей вопрос на конкретизированные технические.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот и гости: 34

    TopList