VBScript中的LZW壓縮演算法

2021-10-06 12:06:31 字數 3643 閱讀 7039

介紹本文向您展示如何在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...