首页 最新文章网站编程正文

进阶 | 通过VBA转换gzip数据流的方法

space: normal;background-color: rgb(255, 255, 255);box-sizing: border-box !important;overflow-wrap: break-word !important">
最近在写一个Excel的工具,涉及到调用一些搜索引擎的API接口
像百度等主流的平台,接口已经非常完善了,基本上通过json的方式就可以拿到想要的任何数据;但像搜狗这样的二流平台,接口就显得落伍了很多,仍采用传统的SOAP的方式调用,关键是不能够直接获取到想要的数据,因为EXCEL结合VBA的显著优势是可以直接进行数据的处理与展现,如果这一优势不能直接发挥作用,EXCEL与vba结合的效益就会大打折扣。
而搜狗的流程是先生成zip格式的报告,再下载,下载后再解压,解压后再读取到Excel,处理过程的复杂度大大增加。
我在想能否可以直接通过http链接获取到zip文件,不下载到本地,然后转化gzip数据流并读取到excel,这就能够简化操作,同时降低对工具使用者系统环境的依赖,显得可移植性更高。
但是经过反复尝试,发现想100%的不依赖于用户系统环境也不现实,这个依赖主要是需要在使用者的电脑中注册GZip.dll,这是解析gzip信息流所需要的必要条件。
下面这段代码是我通过不断调试,最终可以直接转换gzip数据流,只需要把gzip文件的下载链接通过参数传给主函数即可。
全局引用
'使用该功能首先需要注册gizp.dll,将该文件放置到C:\windows\SysWOW64(针对windows7系统)
Public Const OFFSET As Long = &H8
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function InitDecompression Lib "gzip.dll" () As Long
Public Declare Function CreateDecompression Lib "gzip.dll" (ByRef context As Long, ByVal Flags As Long) As Long
Public Declare Function DestroyDecompression Lib "gzip.dll" (ByRef context As Long) As Long
Public 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
Public 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
'定义常量
Const cp_UTF8 = 65001
Const cp_GB2312 = 936
Const cp_GB18030 = 54936
Const cp_UTF7 = 65000
'############################################
'主函数:将压缩文件转换成信息流
' 参数:downloadUrl待转换的gzip文件的下载路径
'返回值:以数组的形式返回转换后的信息
'############################################
Public Function getGzipDirect(downloadUrl As String)
    '定义局部变量
    Dim brr() As Byte
    Dim a As String
    ReDim brr(0)
    '发起http请求以获取压缩文件(文件后缀名.zip)
    With CreateObject("WinHttp.WinHttprequest.5.1")
        .Open "GET", downloadUrl, False
        .send
        brr = .responseBody
    End With
    'Windows API函数:能将一块内存数据从一个位置复制到另一个位置
    CopyMemory brr(0), brr(i), UBound(brr)
    '重新分配数组空间。默认情况下重新分配空间后数组内容都会清空,加上preserve后可以保留原来的数据在进行分配空间
    ReDim Preserve brr(UBound(brr) - 8)
    'zlib是通用的压缩库函数:将source缓冲区的内容解压缩到dest缓冲区
    '解压gzip流
    UnCompressByte brr
    '将解压后的gzip流转换成unicode格式的内容
    a = Utf8ToUnicode(brr)
   '按行分拆成数组
    unzipArr = Split(a, Chr(10))
    '取得gzip解压后并转换成的Unicode字符内容,并作为主函数的返回值
    getGzipDirect = Split(unzipArr(1), ",")
End Function
'函数功能:映射一个字符串到一个宽字符(unicode)的字符串
Public 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
    '设置缓冲区大小(为待处理数据串的2倍)
    lBufferSize = lLength * 2
    Utf8ToUnicode = String$(lBufferSize, Chr(0))
    '各参数的释义如下:
    'cp_GB2312:指定转换字符集
    '0:用以指出是否未转换成预作或宽字符的位标记
    'VARPtr(Utf(0)):将被转换字符串的字符
    'lLength:指定由参数lVarPtr(Utf(0))指向的字符串中字节的个数
    'StrPtr(Utf8ToUnicode):接收被转换字符串的缓冲区
    'lBufferSize:由参数lStrPtr(Utf8ToUnicode)指向的缓冲区的宽字符个数
    lRet = MultiByteToWideChar(cp_GB2312, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
    '函数运行失败,返回值为0;否则返回由StrPtr(Utf8ToUnicode)指向的缓冲区中写入的宽字符数
    If lRet <> 0 Then
        Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
    Else
        Utf8ToUnicode = ""
    End If
End Function
'函数功能:解压gzip流
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


评论

百度搜索

站点信息

  • 文章总数:511
  • 页面总数:7
  • 分类总数:29
  • 标签总数:869
  • 评论总数:286
  • 浏览总数:6900185
Copyright ©2019-2020.Powered by©刘相涛 辽ICP备14000512号-5