介紹本文向您展示如何在vbscript中實現lzw無失真壓縮演算法。 它也可以按原樣或幾乎按原樣在vba中使用。
lzw演算法lzw演算法是一種壓縮技術,不會造成資料丟失。 它構建了動態壓縮中使用的**和值的字典。 字典不與壓縮檔案一起儲存,並且在壓縮後將其丟棄。 在解壓縮期間,將從壓縮的資料重建字典。
lzw演算法通過以下方式起作用:
初始化字典以包含所有長度為一的字串
在字典中找到與當前輸入匹配的最長字串
輸出該匹配輸入的字典**
將輸入中的下乙個字元追加到匹配的輸入字串,並使用新**將其新增為新的字典值
前往步驟2
守則及其使用方法下面的**是vbscript中lzw演算法的示例實現,可輕鬆移植到vba。 函式是lzwcompress和lzwuncompress,並以檔案路徑為引數。
字典被初始化為8位值的完整範圍,並且每個鍵使用16位。 字典在達到65535個鍵後會重新初始化,我這樣做是為了易於實現,即使這也意味著它沒有盡可能壓縮。
我對大型access資料庫的測試顯示,壓縮級別為86%,而使用7zip中的lzma演算法使用「超」級別壓縮的壓縮率為93%。
由於我一次讀取1個位元組的檔案,因此該演算法的執行速度也很慢。 同樣,這是由於易於實施。 將大量檔案讀入記憶體而不是逐字節讀取會更有效。
option explicit
function lzwcompress(strpath)
dim ofs, ofread, ofwrite, odict, strnext, strcurrent, intmaxcode, i
set odict = createobject("scripting.dictionary")
set ofs = createobject("scripting.filesystemobject")
set ofread = ofs.opentextfile(strpath, forreading)
set ofwrite = ofs.opentextfile(strpath & ".lzw", forwriting, true)
set ofs = nothing
intmaxcode = 255
strcurrent = ofread.read(1)
for i = 0 to 255
odict.add chr(i), i
next
do until ofread.atendofstream
strnext = ofread.read(1)
if odict.exists(strcurrent & strnext) then
strcurrent = strcurrent & strnext
else
ofwrite.write(chr(cbyte(odict.item(strcurrent) \ 256)) & chr(cbyte(odict.item(strcurrent) mod 256)))
intmaxcode = intmaxcode + 1
odict.add strcurrent & strnext, intmaxcode
strcurrent = strnext
if intmaxcode = 65535 then
intmaxcode = 255
odict.removeall
for i = 0 to 255
odict.add chr(i), i
next
end if
end if
loop
ofwrite.write(chr(cbyte(odict.item(strcurrent) \ 256)) & chr(cbyte(odict.item(strcurrent) mod 256)))
ofread.close
ofwrite.close
set ofread = nothing
set ofwrite = nothing
set odict = nothing
end function
function lzwuncompress(strpath)
dim ofs, ofread, ofwrite, odict, intnext, intcurrent, intmaxcode, i, strnext
set odict = createobject("scripting.dictionary")
set ofs = createobject("scripting.filesystemobject")
set ofread = ofs.opentextfile(strpath, forreading)
set ofwrite = ofs.opentextfile(strpath & ".unc", forwriting, true)
set ofs = nothing
intmaxcode = 255
strnext = ofread.read(2)
intcurrent = 0
for i = 1 to len(strnext)
intcurrent = intcurrent + 256 ^ (len(strnext) - i) * asc(mid(strnext, i, 1))
next
for i = 0 to 255
odict.add i, chr(i)
next
do until ofread.atendofstream
ofwrite.write(odict.item(intcurrent))
intmaxcode = intmaxcode + 1
strnext = ofread.read(2)
intnext = 0
for i = 1 to len(strnext)
intnext = intnext + 256 ^ (len(strnext) - i) * asc(mid(strnext, i, 1))
next
if odict.exists(intnext) then
odict.add intmaxcode, odict.item(intcurrent) & left(odict.item(intnext), 1)
else
odict.add intmaxcode, odict.item(intcurrent) & left(odict.item(intcurrent), 1)
end if
if intmaxcode = 65535 then
intmaxcode = 255
odict.removeall
for i = 0 to 255
odict.add i, chr(i)
next
end if
intcurrent = intnext
loop
ofwrite.write(odict.item(intcurrent))
ofread.close
ofwrite.close
set ofread = nothing
set ofwrite = nothing
set odict = nothing
end function
from: lzw壓縮演算法 VBScript中的LZW壓縮演算法
lzw壓縮演算法 介紹本文向您展示如何在vbscript中實現lzw無失真壓縮演算法。它也可以按原樣或幾乎按原樣在vba中使用。lzw演算法lzw演算法是一種壓縮技術,不會導致資料丟失。它構建了動態壓縮中使用的 和值的字典。該詞典不與壓縮檔案一起儲存,並且在壓縮後將被丟棄。在解壓縮期間,將從壓縮的資...
LZW字典壓縮
首先談談我對壓縮這個詞的理解吧。在我看來,壓縮 協議。而這二者中,我認為協議比 更重要,協議是整個壓縮的靈魂。就拿哈夫曼壓縮法來說,它的協議簡單來說就是為待壓縮檔案中出現過的每個字元設定乙個編碼,標頭檔案中儲存了每個編碼對應的字元資訊。顯然,哈夫曼壓縮中的標頭檔案就是我們定下的壓縮協議。今天主要談l...
LZW壓縮演算法
lzw演算法和lz78演算法在編碼方式上的不同 步驟1 開始時的詞典包含所有可能的根 root 當前字首p為空 步驟3 判斷綴 符串p char是否在詞典中 1 如果 是 p p char 用char擴充套件p 2 如果 否 把代表當前字首p的碼字輸出到碼字流 把綴 符串p char新增到詞典 令p...