comp_reducerhalfdict.bas

21加密算法,用vB语言编写实现,可了解各种加密算法的结构

            Temp = Temp * 2 + (-1 * ((FromArray(FromPos) And 2 ^ (7 - FromBit)) > 0))
            FromBit = FromBit + 1
            If FromBit = 8 Then
                If FromPos + 1 > UBound(FromArray) Then
                    Do While X < Numbits
                        Temp = Temp * 2
                        X = X + 1
                    Loop
                    FromPos = FromPos + 1
                    Exit For
                End If
                FromPos = FromPos + 1
                FromBit = 0
            End If
        Next
        ReadBitsFromArray = Temp
    End If
End Function

'this sub will add a char into the outputstream
Private Sub AddCharToArray(Toarray() As Byte, ToPos As Long, Char As Byte)
    If ToPos > UBound(Toarray) Then ReDim Preserve Toarray(ToPos + 500)
    Toarray(ToPos) = Char
    ToPos = ToPos + 1
End Sub


Private Sub MakeHuffTreeForReducer(ByteArray() As Byte)
    Dim TreeNodes(511, 4) As Long
    Dim CharPos(128, 1) As Long
    Dim CharCount(128) As Long
    Dim BitLens() As Long
    Dim CharLens() As String
    Dim BitLen As Integer
    Dim TotBits As Integer
    Dim Char As Byte
    Dim X As Long
    Dim Y As Integer
    Dim Z As Integer
    Dim NumberOfNodes As Integer
    Dim OrgNumberOfNodes As Integer
    Dim MaxWeight As Long
    Dim NowWeight As Long
    Dim ByteVal As Integer
    Dim BitsDeep As Byte
    Dim lWeight As Long
    Dim rWeight As Long
    Dim lNode As Integer
    Dim rNode As Integer
    Dim DictString As String
    Dim TotBytes As Integer
'even snel de dictionary opzetten
    Dictionary = ""
    For X = 0 To 255
        Dictionary = Dictionary & Chr(X)
        DictCharCount(X) = 0
    Next
    DictCharCount(256) = 0
'eerst gaan we de input doorlezen op zoek naar het meest voorkomende karakter
    For X = 0 To UBound(ByteArray)
        ByteVal = ByteArray(X)
        BitsDeep = ReducerBits(ByteVal)
        CharCount(BitsDeep) = CharCount(BitsDeep) + 1
    Next
    ByteVal = 256
    BitsDeep = ReducerBits(ByteVal)
    CharCount(BitsDeep) = CharCount(BitsDeep) + 1
'hier worden de aantal gesorteerd en in de groep gezet
'    For BitsDeep = 0 To 8
    'nu gaan we diegene die 0 maal voorkomen verwijderen
    'en gelijk maar de blaadjes aanmaken
        ReDim BitLens(16)
        ReDim CharLens(16)
        
        MaxWeight = UBound(ByteArray) + 1
        NumberOfNodes = -1
Need_Minimum2:
        For X = 0 To 128
            If CharCount(X) <> 0 Then
                NumberOfNodes = NumberOfNodes + 1
                TreeNodes(NumberOfNodes, 0) = CharCount(X)
                TreeNodes(NumberOfNodes, 1) = X
                TreeNodes(NumberOfNodes, 2) = -1    'leftnode
                TreeNodes(NumberOfNodes, 3) = -1    'rightnode
                TreeNodes(NumberOfNodes, 4) = -1    'parentnode
            End If
        Next
        If NumberOfNodes = 0 Then GoTo Need_Minimum2
    'nu gaan we de boom samenstallen (blaadjes verbinden met de stam)
        OrgNumberOfNodes = NumberOfNodes
        For X = NumberOfNodes + 1 To 2 Step -1
            lWeight = MaxWeight * 2: rWeight = MaxWeight * 2
            For Y = 0 To NumberOfNodes + 1
                If TreeNodes(Y, 4) = -1 Then
                    NowWeight = TreeNodes(Y, 0)
                    If NowWeight < rWeight Or NowWeight < lWeight Then
                        If rWeight > lWeight Then
                            rWeight = NowWeight
                            rNode = Y
                        Else
                            lWeight = NowWeight
                            lNode = Y
                        End If
                    End If
                End If
            Next Y
            NumberOfNodes = NumberOfNodes + 1
            TreeNodes(lNode, 4) = NumberOfNodes
            TreeNodes(rNode, 4) = NumberOfNodes
            TreeNodes(NumberOfNodes, 0) = lWeight + rWeight
            TreeNodes(NumberOfNodes, 1) = -1
            TreeNodes(NumberOfNodes, 2) = lNode
            TreeNodes(NumberOfNodes, 3) = rNode
            TreeNodes(NumberOfNodes, 4) = -1
        Next
    'nu gaan we de bitsequence bepalen
    'en tegelijk gaan we bereken hoe lang de gecodeerde file wordt
    'en hoe groot of dat de dictionary wordt
        TotBits = 0
        For X = 0 To OrgNumberOfNodes
            Char = TreeNodes(X, 1)
            Y = X
            Z = Y
            BitLen = 0
            Do While TreeNodes(Y, 4) <> -1
                Y = TreeNodes(Y, 4)
                If TreeNodes(Y, 2) = Z Or TreeNodes(Y, 3) = Z Then
                    BitLen = BitLen + 1
                Else
                    MsgBox "error creating bitpatern"
                    Exit Sub
                End If
                Z = Y
            Loop
            If TotBits < BitLen Then TotBits = BitLen
            BitLens(BitLen) = BitLens(BitLen) + 1
            CharLens(BitLen) = CharLens(BitLen) & Chr(Char)
        Next
        DictString = ""
        DictString = Chr(TotBits)
        For X = 1 To TotBits
            DictString = DictString & Chr(BitLens(X))
        Next
        For X = 1 To TotBits
            DictString = DictString + CharLens(X)
        Next
        HuffDict = DictString
        Call Create_Huffcodes(DictString, True)
'    Next
End Sub

Private Sub Create_Huffcodes(DictString As String, ForCompress As Boolean)
    Dim Code As Long
    Dim TotKars As Integer
    Dim TotLengs As Integer
    Dim ReadPos As Integer
    Dim bl_count() As Integer
    Dim TreeLang() As Integer
    Dim MaxLang As Integer
    Dim TreeCode() As Long
    Dim next_code() As Long
    Dim Chars() As Integer
'    Dim Bits As Integer
    Dim BitString As String
    Dim BitLen As Integer
    Dim Numbits As Integer
    Dim MaxBits As Integer
    Dim maxcode As Long
    Dim N As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim Lang As Integer
    ReDim BitVal(0)
    ReDim CharVal(0)
'    Call Create_Bytes2
    MaxBits = ASC(Mid(DictString, 1, 1))
    ReDim Preserve bl_count(MaxBits)
    ReadPos = 2
    MaxLang = -1
    For X = 1 To MaxBits
        Numbits = ASC(Mid(DictString, ReadPos, 1))
        If Numbits > 0 Then
            BitLen = X
            bl_count(BitLen) = Numbits
            ReDim Preserve TreeLang(MaxLang + Numbits)
            For Y = 1 To Numbits
                MaxLang = MaxLang + 1
                TreeLang(MaxLang) = BitLen
            Next
        End If
        ReadPos = ReadPos + 1
    Next
    If MaxLang = -1 Then Exit Sub
    ReDim TreeCode(MaxLang)
    ReDim next_code(MaxBits)
    ReDim Chars(MaxLang)
    For X = 0 To MaxLang
        Chars(X) = ASC(Mid(DictString, ReadPos, 1))
        ReadPos = ReadPos + 1
    Next
    maxcode = 0
    Code = 0
    For N = 1 To MaxBits
        Code = (Code + bl_count(N - 1)) * 2
        next_code(N) = Code
    Next
    For N = 0 To MaxLang
        Lang = TreeLang(N)
        TreeCode(N) = next_code(Lang)
        next_code(Lang) = next_code(Lang) + 1
        If maxcode < next_code(Lang) Then maxcode = next_code(Lang)
    Next
    If ForCompress = True Then
        ReDim Preserve BitVal(255)
        ReDim Preserve CharVal(255)
        For X = 0 To MaxLang
            BitVal(Chars(X)) = TreeCode(X)
            CharVal(Chars(X)) = TreeLang(X)
'Debug.Print Chars(X); " "; DecToBin1(CLng(TreeCode(X)), CLng(TreeLang(X)))
        Next
'Debug.Print
    Else
        ReDim Preserve BitVal(maxcode - 1)
        ReDim Preserve CharVal(maxcode - 1)
        For X = 0 To MaxLang
            BitVal(TreeCode(X)) = TreeLang(X)
            CharVal(TreeCode(X)) = Chars(X)
'Debug.Print Chars(X); " "; DecToBin1(CLng(TreeCode(X)), CLng(TreeLang(X)))
        Next
'Debug.Print
    End If
    
End Sub