cod_freqshift.bas

20多种VB软件的加密与压缩模块

Attribute VB_Name = "Cod_FreqShift"


Option Explicit

Private Dictionary As String
Private CharCount(256) As Long

'This coder Makes Use of a dictionary of all ascii characters
'it will count the times a character is encountered
'Every time a certain character is encounterd it will be shifted
'forward in the directory untill it is in front or untill the character
'before it has a higher rate

Public Sub FrequentShifter_Coder(ByteArray() As Byte)
    Dim X As Long
    Dim Temp As Byte
    Call Init_FrequentShifter
    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 FrequentShifter_DeCoder(ByteArray() As Byte)
    Dim X As Long
    Dim Temp As Byte
    Call Init_FrequentShifter
    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_FrequentShifter()
    Dim X As Integer
    Dictionary = ""
    For X = 0 To 255
        Dictionary = Dictionary & Chr(X)
        CharCount(X) = 0
    Next
    CharCount(256) = 0
End Sub

Private Sub update_Model(Char As Byte)
    Dim DictPos As Integer
    Dim OldPos As Integer
    Dim Temp As Long
    DictPos = InStr(Dictionary, Chr(Char)) - 1
    OldPos = DictPos
    CharCount(DictPos) = CharCount(DictPos) + 1
    Do While DictPos > 0
        If CharCount(DictPos) < CharCount(DictPos - 1) Then Exit Do
        Temp = CharCount(DictPos - 1)
        CharCount(DictPos - 1) = CharCount(DictPos)
        CharCount(DictPos) = Temp
        DictPos = DictPos - 1
    Loop
    If OldPos = DictPos Then Exit Sub
    Dictionary = Left(Dictionary, DictPos) & Chr(Char) & Mid(Dictionary, DictPos + 1, OldPos - DictPos) & Mid(Dictionary, OldPos + 2)
End Sub