cod_valdownshift.bas

包含几十个加密解密类和压缩解压缩类,DES,LZW,Huffman

Attribute VB_Name = "Cod_ValDownShift"

' **********************************************************************
'  描  述：21种加密54种压缩 算法模块 海阔天空收集整理
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空整理,有问题请上www.paly78.com 提
'  网址：http://www.play78.com/
'  QQ：13355575
'  e-mail:[e-mail]
' **********************************************************************
Option Explicit

Private Dictionary As String

'This coder work with a dictionary of all ascii codes
'but don't keep track of the counts
'every time a character is encountered it will be shifted with
'the character wich stand one position earlier in the dictionary

Public Sub ValueDownShifter_Coder(ByteArray() As Byte)
    Dim X As Long
    Dim Temp As Byte
    Call Init_ValueDownShifter
    For X = 0 To UBound(ByteArray)
        Temp = ByteArray(X)
        ByteArray(X) = InStr(Dictionary, Chr(Temp)) - 1
        Call update_Model(Temp)
    Next
End Sub

Public Sub ValueDownShifter_DeCoder(ByteArray() As Byte)
    Dim X As Long
    Dim Temp As Byte
    Call Init_ValueDownShifter
    For X = 0 To UBound(ByteArray)
        Temp = ASC(Mid(Dictionary, ByteArray(X) + 1, 1))
        ByteArray(X) = Temp
        Call update_Model(Temp)
    Next
End Sub

Private Sub Init_ValueDownShifter()
    Dim X As Integer
    Dictionary = ""
    For X = 0 To 255
        Dictionary = Dictionary & Chr(X)
    Next
End Sub

Private Sub update_Model(Char As Byte)
    Dim DictPos As Integer
    Dim TwistChar As String
    DictPos = InStr(Dictionary, Chr(Char))
    If DictPos > 1 Then
        TwistChar = Mid(Dictionary, DictPos - 1, 1)
        Dictionary = Left(Dictionary, DictPos - 2) & Chr(Char) & TwistChar & Mid(Dictionary, DictPos + 1)
    End If
End Sub