742
社区成员
发帖
与我相关
我的任务
分享
Dim ArrayByte() As Byte '定义窗体变量用来保存winsock接收的字节数组
'gzip数组解压
Private Const OFFSET As Long = &H8
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function InitDecompression Lib "gzip.dll" () As Long
Private Declare Function CreateDecompression Lib "gzip.dll" (ByRef context As Long, ByVal Flags As Long) As Long
Private Declare Function DestroyDecompression Lib "gzip.dll" (ByRef context As Long) As Long
Private Declare Function Decompress Lib "gzip.dll" (ByVal context As Long, inBytes As Any, ByVal input_size As Long, outBytes As Any, ByVal output_size As Long, ByRef input_used As Long, ByRef output_used As Long) As Long
'UTF8解码
Private Const CP_UTF8 = 65001
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
'解码UTF8字节数组
Function Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
Else
Utf8ToUnicode = ""
End If
End Function
'解压缩数组
Public Function UnCompressByte(ByteArray() As Byte) As Boolean
Dim BufferSize As Long
Dim Buffer() As Byte
Dim lReturn As Long
Dim outUsed As Long
Dim inUsed As Long
'创建解压缩后的缓存
CopyMemory BufferSize, ByteArray(0), OFFSET
BufferSize = BufferSize + (BufferSize * 0.01) + 12
ReDim Buffer(BufferSize) As Byte
'创建解压缩进程
Dim contextHandle As Long: InitDecompression
CreateDecompression contextHandle, 1 '创建
'解压缩数据
lReturn = Decompress(ByVal contextHandle, ByteArray(0), UBound(ByteArray) + 1, Buffer(0), BufferSize, inUsed, outUsed)
DestroyDecompression contextHandle
'删除重复的数据
ReDim Preserve ByteArray(0 To outUsed - 1)
CopyMemory ByteArray(0), Buffer(0), outUsed
End Function
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim MyFile() As Byte, MyLong As Long
ReDim MyFile(bytesTotal - 1)
Winsock1.GetData MyFile
MyLong = UBound(ArrayByte)
ReDim Preserve ArrayByte(MyLong + bytesTotal)
CopyMemory ArrayByte(MyLong + 1), MyFile(0), bytesTotal
End Sub
Private Sub Form_Load()
ReDim ArrayByte(0) '初始化接收数组,winsock1连接前重置更好
End Sub
'还原数据
Private Sub Command1_Click()
Dim i As Long, Stmp As String
'处理包头和包尾
For i = 0 To UBound(ArrayByte)
'gzip流特征:回车,换行,ID1=31(0x1F) ID2=139(0x8B),采用前面3个连续的数据作为判断依据
If ArrayByte(i) = 31 Then
If ArrayByte(i - 2) = 13 And ArrayByte(i - 1) = 10 Then
Exit For
End If
End If
Next
CopyMemory ArrayByte(0), ArrayByte(i), UBound(ArrayByte) - i '去掉包头
ReDim Preserve ArrayByte(UBound(ArrayByte) - i - 8) '末尾8个字节不是gzip流,此处可能根据网页数据要多次尝试,末尾4字节肯定不属于gzip流
UnCompressByte ArrayByte '解压GZIP流
Stmp = Utf8ToUnicode(ArrayByte)
End Sub
Shell "C:\Program Files\winrar\UnRAR.exe x C:\Temp\web.rar C:\temp\web\"