VBScript中的LZW压缩算法

LZW算法

LZW算法是一种压缩技术，不会导致数据丢失。它构建了一个用于压缩的代码和值的字典。字典不与压缩文件一起存储，并在压缩后丢弃。在解压缩期间，字典从压缩数据重建。

LZW算法的功能如下：

1. 初始化字典以包含所有长度为1的字符串

2. 找到匹配当前输入的字典中最长的字符串

3. 输出该匹配输入的字典代码

4. 将下一个字符从输入添加到匹配的输入字符串，并将其作为新的字典值添加新的代码

5. 转到步骤2

代码和如何使用

下面的代码是VBScript中的LZW算法的一个示例实现，并且易于移植到VBA中。功能是LZWCompress和LZWUncompress，并以文件路径为参数。

字典被初始化为8位值的全范围，每个键使用16位。达到65535个键之后，该字典将重新初始化，这样我就可以轻松实现，尽管这也意味着它不像压缩一样。

对于大型Access数据库，我的测试显示了86％的压缩级别，而使用LZMA算法的超级级别压缩使用7zip压缩率为93％。

我的算法实现也很慢，因为我一次读取文件1个字节。再次，这是由于易于实施。

展开| 选择| 包裹| 行号

1. 选项显式

2. Const ForReading = 1，ForWriting = 2，ForAppending = 8

3.  

4. 功能LZWCompress（strPath）

5. Dim oFS，oFRead，oFWrite，oDict，strNext，strCurrent，intMaxCode，i

6.  

7. 设置oDict = CreateObject（Scripting.Dictionary）

8. 设置oFS = CreateObject（Scripting.FileSystemObject）

9. 设置oFRead = oFS.OpenTextFile（strPath，ForReading）

10. 设置oFWrite = oFS.OpenTextFile（strPath＆.lzw，ForWriting，True）

11. 设置oFS =没有

12. intMaxCode = 255

13. strCurrent = oFRead.Read（1）

14.  

15. 对于i = 0到255

16. oDict.Add Chr（i），i

17. 下一个

18.  

19. 直到oFRead.AtEndOfStream

20. strNext = oFRead.Read（1）

21.  

22. 如果oDict.Exists（strCurrent＆strNext）那么

23. strCurrent = strCurrent＆strNext

24. 其他

25. oFWrite.Write（Chr（CByte（oDict.Item（strCurrent）\ 256））＆Chr（CByte（oDict.Item（strCurrent）Mod 256）））

26.  

27. intMaxCode = intMaxCode + 1

28. oDict.Add strCurrent＆strNext，intMaxCode

29. strCurrent = strNext

30.  

31. 如果intMaxCode = 65535那么

32. intMaxCode = 255

33. oDict.RemoveAll

34.  

35. 对于i = 0到255

36. oDict.Add Chr（i），i

37. 下一个

38. 万一

39. 万一

40. 循环

41.  

42. oFWrite.Write（Chr（CByte（oDict.Item（strCurrent）\ 256））＆Chr（CByte（oDict.Item（strCurrent）Mod 256）））

43.  

44. oFRead.Close

45. oFWrite.Close

46. 设置oFRead =没有

47. 设置oFWrite =没有

48. 设置oDict =没有

49. 结束功能

50.  

51. 功能LZWUncompress（strPath）

52. Dim oFS，oFRead，oFWrite，oDict，intNext，intCurrent，intMaxCode，i，strNext

53.  

54. 设置oDict = CreateObject（Scripting.Dictionary）

55. 设置oFS = CreateObject（Scripting.FileSystemObject）

56. 设置oFRead = oFS.OpenTextFile（strPath，ForReading）

57. 设置oFWrite = oFS.OpenTextFile（strPath＆.unc，ForWriting，True）

58. 设置oFS =没有

59. intMaxCode = 255

60. strNext = oFRead.Read（2）

61. intCurrent = 0

62. 对于i = 1到Len（strNext）

63. intCurrent = intCurrent + 256 ^（Len（strNext） - i）* Asc（Mid（strNext，i，1））

64. 下一个

65.  

66. 对于i = 0到255

67. oDict.Add i，Chr（i）

68. 下一个

69.  

70. 直到oFRead.AtEndOfStream

71. oFWrite.Write（oDict.Item（intCurrent））

72. intMaxCode = intMaxCode + 1

73.  

74. strNext = oFRead.Read（2）

75. intNext = 0

76. 对于i = 1到Len（strNext）

77. intNext = intNext + 256 ^（Len（strNext） - i）* Asc（Mid（strNext，i，1））

78. 下一个

79.  

80. 如果oDict.Exists（intNext）然后

81. oDict.Add intMaxCode，oDict.Item（intCurrent）＆Left（oDict.Item（intNext），1）

82. 其他

83. oDict.Add intMaxCode，oDict.Item（intCurrent）＆Left（oDict.Item（intCurrent），1）

84. 万一

85.  

86. 如果intMaxCode = 65535那么

87. intMaxCode = 255

88. oDict.RemoveAll

89.  

90. 对于i = 0到255

91. oDict.Add i，Chr（i）

92. 下一个

93. 万一

94.  

95. intCurrent = intNext

96. 循环

97. oFWrite.Write（oDict.Item（intCurrent））

98.  

99. oFRead.Close

100. oFWrite.Close

101. 设置oFRead =没有

102. 设置oFWrite =没有

103. 设置oDict =没有

104. 结束功能