如何压缩  Open FileName For Binary As #1  打开方式的内容
Get #1, , ABC如何 对数组ABC 压缩 求一个算法.

解决方案 »

  1.   

    可参考塞北雪貂的文章:【塞北雪貂】vb6中用zlib.dll实现字节数组压缩/解压缩
      

  2.   

    http://blog.csdn.net/Modest/archive/2006/04/13/662072.aspx
    vb6中用zlib.dll实现压缩/解压缩字节数组
      

  3.   

    压缩的数据就是原来的数组,比如:
    Dim a() as Byte
    a=......
    CompressByte a  '压缩数组现在的a就是压缩过的了,解压缩部分同理。
      

  4.   

    以前好象在论坛上贴过一个链接(现在已经失效了)Attribute VB_Name = "mdlFilePacketC"'=======================================================
    '2003/08 by unsigned(僵哥) with Delphi6.0 in ShangHai
    '-------------------------------------------------------
    '$GB$
    '               本程式专为DCOM/COM+ 网络文件传输使用
    '               将任何类型的数据实文件打包成Variant数据包
    '               并可选用ZLib算法,以Default Level进行压缩处理
    '
    '======================================================Option ExplicitPrivate Function FilePacketObject() As FilePacketC.FilePacketC
       
       Set FilePacketObject = CreateObject("FilePacketC.FilePacketC")
       
    End Function'======================================================
    'Use Zlib Pack the Stream by default Level
    '------------------------------------------------------
    '$GB$
    '使用Zlib算法将一个Variant数据包压缩
    '
    '注:
    '    此压缩会将原来Variant存储格式破坏,并永久性不可恢复
    '    全部都为Byte类型
    '
    '======================================================
    Public Sub PackStream(ByRef Stream As Variant)
       
       FilePacketObject.PackStream Stream
       
    End Sub'==========================================================
    'Read from FileName to Packet as Variant type with no pack,
    'and delete the source file
    '----------------------------------------------------------
    '$GB$
    '将文件名为FileName的实文件转成未压缩的Variant型数据包,并删除掉原始文件
    '
    '----------------------------------------------------------
    '$BIG5$
    '
    '==========================================================
    Public Sub ReadFile2(ByVal FileName As String, ByRef Packet As Variant)
          
       FilePacketObject.ReadFile2 FileName, Packet
       
    End Sub'=======================================================================
    'Read from FileName to Packet as Variant type with no pack and no delete
    '-----------------------------------------------------------------------
    '$GB$
    '将文件名为FileName的实文件转成未压缩的Variant型数据包,不删除原始文件
    '
    '=======================================================================
    Public Sub ReadFile(ByVal FileName As String, ByRef Packet As Variant)
       
       FilePacketObject.ReadFile FileName, Packet
       
    End Sub'Read from FileName to Packet as Variant type with Zlib Pack by default Level
    'and delete the source file
    Public Sub ReadFilePacket(ByVal FileName As String, ByRef Packet As Variant)
       
       FilePacketObject.ReadFilePacket FileName, Packet
       
    End Sub'Read from FileName to Packet as Vairant type with Zlib Packed by default Level
    'and no delete
    Public Sub ReadFilePacket2(ByVal FileName As String, ByRef Packet As Variant)
       
       FilePacketObject.ReadFilePacket2 FileName, Packet
       
    End Sub'Unpack the Zlib Packed Stream
    '(as the first is a 8 byte / int64 type stored the length of the Stream before Packed)
    'to Stream
    Public Sub UnPackStream(ByRef Stream As Variant)   FilePacketObject.UnPackStream Stream
       
    End Sub'Write the Stream to FileName
    Public Function WriteFile(ByRef Stream As Variant, ByVal FileName As String) As Long
       
       WriteFile = FilePacketObject.WriteFile(Stream, FileName)
       
    End Function'Unpack the Zlib Packed Stream
    '(as the first is a 8 bytes / int64 type stored the length of the Stream before Packed)
    'and write to FileName
    Public Function WriteFileStream(ByRef Stream As Variant, ByVal FileName As String) As Long   WriteFileStream = FilePacketObject.WriteFileStream(Stream, FileName)
       
    End Function
      

  5.   

    压缩的时候传入variant型,内容为byte数组
    Dim str As String
    Dim packed_bytes As Variant
    Dim unpacked_bytes As Variantstr = "随便测试一个相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长的字符串"'压缩
    packed_bytes = StrConv(str, vbFromUnicode)
    Call PackStream(packed_bytes)'解压缩
    unpacked_bytes = packed_bytes
    Call UnPackStream(unpacked_bytes)str = StrConv(unpacked_bytes, vbUnicode)
    MsgBox str
      

  6.   

    http://download.csdn.net/source/707381
      

  7.   

    前面的测试代码当中多了一个转换,实际也可以不用转换.
    Dim str As String
    Dim packed_bytes As Variant
    Dim unpacked_bytes As Variantstr = "随便测试一个相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长相当长的字符串"'压缩
    packed_bytes = str 'StrConv(str, vbFromUnicode)
    MsgBox "压缩前字节数:" & LenB(packed_bytes)
    Call PackStream(packed_bytes)
    MsgBox "压缩后字节数:" & (UBound(packed_bytes) - LBound(packed_bytes) + 1)
    '解压缩
    unpacked_bytes = packed_bytes
    MsgBox "解压缩前字节数:" & (UBound(unpacked_bytes) - LBound(unpacked_bytes) + 1)
    Call UnPackStream(unpacked_bytes)
    MsgBox "解压缩后字节数:" & LenB(unpacked_bytes)
    str = unpacked_bytes 'StrConv(unpacked_bytes, vbUnicode)
    MsgBox str
      

  8.   

    Private Function FilePacketObject() As FilePacketC.FilePacketC
       
       Set FilePacketObject = CreateObject("FilePacketC.FilePacketC")
       
    End Function
    这有问题.如何引用 FPacketC.dll 呢?
    FilePacketC 一直提示 用户定义类型末定义
      

  9.   

    Private Function FilePacketObject() As FilePacketC.FilePacketC
       
       Set FilePacketObject = CreateObject("FilePacketC.FilePacketC")
       
    End Function
    这有问题.如何引用 FPacketC.dll 呢?
    FilePacketC 一直提示 用户定义类型末定义
      

  10.   

    Project散单Reference当中,添加该DLL即可.
      

  11.   

    为了方便不同的使用习惯,在提供COM接口的同时,也开放了API接口,从而使得在支持API接口的环境当中省去了注册的麻烦,直接把DLL放置在搜索路径当中即可使用.
    下载链接路径:基本Zlib的压缩/解压缩组件(同时支持API接口和COM接口