http gzip - проблема!

[Demonx]

Значит так, делаю запрос на http server через Winsock.
"GET http://alala.lal HTTP/1.1" & vbcrlf & "Host: alala.lal " & vbcrlf & vbcrlf

Получаю данные в компресованном виде (gzip, 'Content-Encoding: gzip'). Вопрос: Как раскомпресовать мне эти данные?

[Dromok]

меня это тоже интересует!!!

[Q2W]

В кирпичах было. И на основном сайте тоже.

[Dromok]

Друзья мои, чтож у вас за политика такая хреновая. Очень сложно получить от вас конкретный ответ. Ну если знаешь где лежит, неужели так сложно кинуть ссылку на топик или на файлик?
Рылся я очень долго на этом сайте и так ничего путного не нашел.
А нашел я то что мне нужно на какомто французском сайте.
Программка разархивирует HTTP ответы и выводит на экран. Использует библиотечку zlib. Исходники лежат тут http://aw.org.ru/drom/vbfrance_source_24208.zip

[Хакер]

Вообщето то для этого следует использовать библу zlib. Она импортирует некую функцию.

Вот декларации (не мои, так что не отвечаю за их работоспособность)

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

Private Declare Function compress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function uncompress Lib "zlib.dll" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

[Alexanbar]

По идее, браузеры это делают без всяких zlib.dll, значит, есть готовая функция. Вот кто бы разрыл это дело!

[Dromok]

Кстати, я упустил из внимания Microsoft Internet Transfer Control
Кто-нибудь знает он поддерживает gzip, или нет?

[Хакер]

Тут видешь как: надо смортреть отправляет ли он заголовок

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

Accept-Encoding: gzip

или

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

Accept-Encodinf: deflate

Если да, то сервер ответит сжатыми данными. Если нет - ничего сжимать не будет (при нормальных настройках, разумеется).

Такчто в любом случае волноваться о том, что ты получишь корявые данные, не придётся. Однако если тебе важен сам факт, поддерживает ли MSITC этот тип сжатия, можно провести эксперимент:

Отрубить все локальные сервера (например Денвер) и создать второый проект со слушающим сервером на порту 80. И при коннекте печатать в Immidiate запрос, посылаемыц MSITC-ом. И посмотреть будет ли там этот заголовок. Если нет, то попробовать в методе Execute послать доп. хеадер "Content-Encoding: gzip" и натравить его на какой нибудь сайт со включенным ГЗипом (например этот bbs.vbstreets.ru или мой fire-lines.com/forum)

Если получим фигню типа

xÚ»ûéÂûï>©OO?~ÒQxôàÇg…7>ýQ

будем радоваться, что MSITC нифига не поддерживает.

(Всё описанное мною здесь не проверялось, и писалось по ходу мысли)

[Dromok]

Тут видешь как: надо смортреть отправляет ли он заголовок

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

Accept-Encoding: gzip

или

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

Accept-Encodinf: deflate

По дефолту он не шлет "Accept-Encoding: gzip"

Вызываем функцию нужным нам образом
Inet1.Execute "localhost", , , "Accept-Encoding: gzip"

Получаем такой HTTP запрос.

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

GET / HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*
Accept-Encoding: gzip
User-Agent: Microsoft URL Control - 6.00.8862
Host: localhost
Cache-Control: no-cache


Так как сервер у нас поддерживает gzip, то в ответ соответвенно получаем данные вида:

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

HTTP/1.1 200 OK
Date: Mon, 23 Oct 2006 06:17:27 GMT
Server: Apache/1.3.37 (Unix) mod_deflate/1.0.21
Expires: 0
Pragma: no-cache
Last-Modified: Mon, 23 Oct 2006 05:17:27 GMT
Connection: close
Transfer-Encoding: chunked
Content-Type: text/html; charset=windows-1251
Content-Encoding: gzip

b85
‹
œ$Ñà@âa]æD ­„÷wöÊ猚ݩpü×°‚Ñé:¬ù!­g";D™
ú’ëf×Æ7—
å4'l÷š=
...


пытаюсь отобразить данные в форме таким образом:

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

Private Sub Inet1_StateChanged(ByVal State As Integer)
    ' Retrieve server response using the GetChunk
   ' method when State = 12.

   Dim vtData As Variant ' Data variable.
   Select Case State
   ' ... Other cases not shown.
   Case icError ' 11
      ' In case of error, return ResponseCode and
      ' ResponseInfo.
      vtData = Inet1.ResponseCode & ":" & _
      Inet1.ResponseInfo
   Case icResponseCompleted ' 12
     
      Dim strData As String
      Dim bDone As Boolean: bDone = False

      ' Get first chunk.
      vtData = Inet1.GetChunk(1024, icString)
      DoEvents

      Do While Not bDone
         strData = strData & vtData
         ' Get next chunk.
         vtData = Inet1.GetChunk(1024, icString)
         DoEvents

         If Len(vtData) = 0 Then
            bDone = True
         End If
      Loop
      Me.Print strData
   End Select

End Sub


В ответ получаем ошибку Run-time error '13': Type mismatch
в строке Inet1.GetChunk(1024, icString)
недолго думая меняем icString на icByteArray
и получаем в окошке строку вида "????5?Я идиот! Убейте меня, кто-нибудь!?..."

Вобщем вывод, Internet Transfer Control не поддерживает gzip.

[Dromok]

никак неполучается на лету разархивировать строку...

может кто-нидь сталкивался? как разархивировать полученные данные по http?

[Dromok]

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

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ZCompress Lib "zlib.dll" Alias "compress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function ZUncompress Lib "zlib.dll" Alias "uncompress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

Public Function Compress(Data, Optional Key)
   Dim lKey As Long  'original size
   Dim sTmp As String  'string buffer
   Dim bData() As Byte  'data buffer
   Dim bRet() As Byte  'output buffer
   Dim lCSz As Long  'compressed size
   
   If TypeName(Data) = "Byte()" Then 'if given byte array data
      bData = Data  'copy to data buffer
   ElseIf TypeName(Data) = "String" Then 'if given string data
      If Len(Data) > 0 Then 'if there is data
         sTmp = Data 'copy to string buffer
         ReDim bData(Len(sTmp) - 1) 'allocate data buffer
         CopyMemory bData(0), ByVal sTmp, Len(sTmp) 'copy to data buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
   End If
   If StrPtr(bData) <> 0 Then 'if data buffer contains data
      lKey = UBound(bData) + 1 'get data size
      lCSz = lKey + (lKey * 0.01) + 12 'estimate compressed size
      ReDim bRet(lCSz - 1) 'allocate output buffer
      Call ZCompress(bRet(0), lCSz, bData(0), lKey) 'compress data (lCSz returns actual size)
      ReDim Preserve bRet(lCSz - 1) 'resize output buffer to actual size
      Erase bData 'deallocate data buffer
      If IsMissing(Key) Then 'if Key variable not supplied
         ReDim bData(lCSz + 3) 'allocate data buffer
         CopyMemory bData(0), lKey, 4 'copy key to buffer
         CopyMemory bData(4), bRet(0), lCSz 'copy data to buffer
         Erase bRet 'deallocate output buffer
         bRet = bData 'copy to output buffer
         Erase bData 'deallocate data buffer
      Else 'Key variable is supplied
         Key = lKey 'set Key variable
      End If
      If TypeName(Data) = "Byte()" Then 'if given byte array data
         Compress = bRet 'return output buffer
      ElseIf TypeName(Data) = "String" Then 'if given string data
         sTmp = Space(UBound(bRet) + 1) 'allocate string buffer
         CopyMemory ByVal sTmp, bRet(0), UBound(bRet) + 1 'copy to string buffer
         Compress = sTmp 'return string buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
      Erase bRet 'deallocate output buffer
   End If
End Function

Public Function Uncompress(Data, Optional ByVal Key)
   Dim lKey As Long  'original size
   Dim sTmp As String  'string buffer
   Dim bData() As Byte  'data buffer
   Dim bRet() As Byte  'output buffer
   Dim lCSz As Long  'compressed size
   
   If TypeName(Data) = "Byte()" Then 'if given byte array data
      bData = Data 'copy to data buffer
   ElseIf TypeName(Data) = "String" Then 'if given string data
      If Len(Data) > 0 Then 'if there is data
         sTmp = Data 'copy to string buffer
         ReDim bData(Len(sTmp) - 1) 'allocate data buffer
         CopyMemory bData(0), ByVal sTmp, Len(sTmp) 'copy to data buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
   End If
   If StrPtr(bData) <> 0 Then 'if there is data
      If IsMissing(Key) Then 'if Key variable not supplied
         lCSz = UBound(bData) - 3 'get actual data size
         CopyMemory lKey, bData(0), 4 'copy key value to key
         ReDim bRet(lCSz - 1) 'allocate output buffer
         CopyMemory bRet(0), bData(4), lCSz 'copy data to output buffer
         Erase bData 'deallocate data buffer
         bData = bRet 'copy to data buffer
         Erase bRet 'deallocate output buffer
      Else 'Key variable is supplied
         lCSz = UBound(bData) + 1 'get data size
         lKey = Key 'get Key
      End If
      ReDim bRet(lKey - 1) 'allocate output buffer
      Call ZUncompress(bRet(0), lKey, bData(0), lCSz) 'decompress to output buffer
      Erase bData 'deallocate data buffer
      If TypeName(Data) = "Byte()" Then 'if given byte array data
         Uncompress = bRet 'return output buffer
      ElseIf TypeName(Data) = "String" Then 'if given string data
         sTmp = Space(lKey) 'allocate string buffer
         CopyMemory ByVal sTmp, bRet(0), lKey 'copy to string buffer
         Uncompress = sTmp 'return string buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
      Erase bRet 'deallocate return buffer
   End If
End Function

код взял с какогото иностранного сайта, непомню уже.
Теперь всё отлично работает. Не только браузер можно написать с поддержкой декомпресии gzip, но и при желании можно написать свой сервер с поддержкой gzip!

Пример работы:

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

dim sCompress as String
dim sUncompress as String
sCompress = Compress("Тестовая строка")
sUncompress = Uncompress(sCompress)
Me.Print sCompress & " " & sUncompress