理论上只要你memory足够大，可以压缩解压缩4GB的字符串
vb所有代码
本地测试,18.8 MB (19,815,840 字节)大小的字符串，得到压缩后字节流大小94.5 KB (96,784 字节)
压缩和计算CRC时间
incrc = 0x88BD9A06
0.6003s
解压缩和计算解压缩后的CRC的时间，用的是未知原字节流大小，先计算推测解压缩需要的缓存区大小，然后再解压缩
如果已知原字节流长度再解压缩的话，更快
outcrc = 0x88BD9A06
0.4434s
压缩后和还原后的CRC32 一致，说明得到的字节流正确
模块:
Option Explicit
Private Declare Function compressAPI Lib "ZLibWAPI.dll" Alias "compress" (ByRef dest As Any, ByRef destLen As Long, ByRef Source As Any, ByVal sourceLen As Long) As Long
Private Declare Function compressBound Lib "ZLibWAPI.dll" (ByVal sourceLen As Long) As Long
Private Declare Function uncompressAPI Lib "ZLibWAPI.dll" Alias "uncompress" (ByRef dest As Any, ByRef destLen As Long, ByRef Source As Any, ByVal sourceLen As Long) As Long
Private Declare Function adler32 Lib "ZLibWAPI.dll" (ByVal adler As Long, ByRef buf As Any, ByVal length As Long) As Long
Private Declare Function crc32 Lib "ZLibWAPI.dll" (ByVal crc As Long, ByRef buf As Any, ByVal length As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Const Z_OK As Long = &H0
Public Const Z_ERROR As Long = -&H1
Public Const Z_BUF_ERROR As Long = -&H5
Private Sub Main()
Form1.Show
End Sub
Public Function compress(ByRef inBytes() As Byte, ByVal BufferSize As Long, ByRef incrc As Long, ByRef outBytes() As Byte) As Long
If BufferSize > 0 Then
incrc = crc32(crc32(0, ByVal 0&, 0), inBytes(0), BufferSize)
Dim outLength As Long
outLength = compressBound(BufferSize)
ReDim outBytes(0 To outLength - 1) As Byte
Dim ret As Long
ret = compressAPI(outBytes(0), outLength, inBytes(0), BufferSize)
Erase inBytes
If ret = Z_OK Then
ReDim Preserve outBytes(0 To outLength - 1)
compress = ret
Else
compress = Z_ERROR
End If
End If
End Function
Public Function uncompress(ByRef inBytes() As Byte, ByVal BufferSize As Long, ByRef outcrc As Long, ByRef outBytes() As Byte) As Long
ReDim outBytes(0 To (BufferSize - 1)) As Byte
Dim ret As Long
ret = uncompressAPI(outBytes(0), BufferSize, inBytes(0), UBound(inBytes) + 1)
Erase inBytes
If (ret = Z_OK) Then
ReDim Preserve outBytes(0 To (BufferSize - 1))
outcrc = crc32(crc32(0, ByVal 0&, 0), outBytes(0), BufferSize)
uncompress = Z_OK
Else
uncompress = Z_ERROR
End If
End Function
Public Function uncompressEx(ByRef inBytes() As Byte, ByRef outcrc As Long, ByRef outBytes() As Byte, ByVal multiple As Integer) As Long
Di
m inLength As Long
inLength = UBound(inBytes) + 1
Dim gzSize As Long
gzSize = multiple * inLength
Dim outBuffer As Long
Dim ret As Long
Do
outBuffer = gzSize
ReDim outBytes(0 To (outBuffer - 1)) As Byte
ret = uncompressAPI(outBytes(0), outBuffer, inBytes(0), inLength)
gzSize = gzSize + inLength
Loop While ret = Z_BUF_ERROR
Erase inBytes
If (ret = Z_OK) Then
ReDim Preserve outBytes(0 To (outBuffer - 1))
outcrc = crc32(crc32(0, ByVal 0&, 0), outBytes(0), outBuffer)
uncompressEx = Z_OK
Else
uncompressEx = Z_ERROR
End If
End Function
Public Function fileToBuffer(ByVal inFile As String, ByRef outBuffer() As Byte) As Long
' make sure file exists
If (Not fileExist(inFile)) Then Exit Function
Dim FNum As Integer
FNum = FreeFile()
Open inFile For Binary Access Read Lock Write As #FNum
ReDim refBuffer(0 To (LOF(FNum) - 1)) As Byte ' allocate buffer
Get #FNum, , refBuffer() ' read file data into buffer
Close #FNum
' return array
outBuffer = refBuffer
fileToBuffer = UBound(refBuffer) + 1
End Function
Public Function flushToFile(ByVal inFile As String, ByRef outBuffer() As Byte) As Long
If (fileExist(inFile)) Then Kill inFile
Open inFile For Output As #1: Close #1 'create empty file
Dim FNum As Integer
FNum = FreeFile() ' get a free file handle
Open inFile For Binary Access Write As #FNum
Put #FNum, , outBuffer() 'flush buffer to local file
Close #FNum
End Function
Private Sub ArrayCopy(ByRef arrSrc() As Byte, ByVal srcPos As Long, ByRef arrDest() As Byte, ByVal destPos As Long, ByVal length As Long)
'make sure srcPos >= LBound(arrSrc) and srcPos + length < UBound(arrSrc) +1
'make sure destPos >= LBound(arrDest) and destPos + length < UBound(arrDest) +1
CopyMemory arrDest(destPos), arrSrc(srcPos), length
End Sub
Private Function WriteBuffer(buffer() As Byte, ByVal srcPos As Long, ByVal length As Long) As Byte()
ReDim retBuffer(length - 1) As Byte
CopyMemory retBuffer(0), buffer(srcPos), length
WriteBuffer = retBuffer
End Function
Private Function fileExist(ByRef inFile As String) As Boolean
On Error Resume Next
fileExist = CBool(FileLen(inFile) + 1)
End Function
时间类
Option Explicit
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private m_Frequency  As Currency
Private m_Start      As Currency
Private m_Now        As Currency
Private m_Available  As Boolean
Private Sub Class_Initialize()
m_Available = (QueryPerformanceFrequency(m_Frequency) <> 0)
If Not m_Available Then
Debug.Print "Performance Counter not available" 
End If
End Sub
Friend Function Elapsed() As Double
QueryPerformanceCounter m_Now
If m_Available Then
Elapsed = 1000 * (m_Now - m_Start) / m_Frequency
End If
End Function
Friend Sub Reset()
QueryPerformanceCounter m_Start
End Sub
窗体
Option Explicit
Private Sub Command1_Click()
Dim inFile As String
inFile = App.Path & "\inBytes.in"
Dim tmpFile As String
tmpFile = App.Path & "\p"
Dim outFile As String
outFile = App.Path & "\outBytes.out"
Dim origSize As Long, inBytes() As Byte
Dim ct1 As New clsTiming
ct1.Reset
origSize = fileToBuffer(inFile, inBytes())
Dim incrc As Long, outBytes() As Byte
If Z_OK = compress(inBytes, origSize, incrc, outBytes) Then
flushToFile tmpFile, outBytes
Debug.Print "incrc = 0x" & Hex(incrc)
End If
Erase inBytes
Debug.Print Format$(ct1.Elapsed / 1000, "0.0000") & "s"
Dim Ct2 As New clsTiming
Ct2.Reset
Dim outcrc As Long, origBytes() As Byte
'已知原字节流大小解压缩
'    If Z_OK = uncompress(outBytes, origSize, outcrc, origBytes) Then
'        Debug.Print "outcrc = 0x" & Hex(outcrc)
'    End If
'未知原字节流大小解压缩
If Z_OK = uncompressEx(outBytes, outcrc, origBytes, 1024) Then
Debug.Print "outcrc = 0x" & Hex(outcrc)
End If
Erase outBytes
flushToFile outFile, origBytes
Erase origBytes
Debug.Print Format$(Ct2.Elapsed / 1000, "0.0000") & "s"
End Sub
yinweihong 发表于：2008-05-23 23:54:0255楼 得分:0
转贴的话麻烦注明一下，谢谢
ZLibWAPI.dll 这个文件就是winImage那里下的
好帖子做个标记
不知道楼主解决问题没有，虽然结贴了……

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。