calc_entropy.bas

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

Attribute VB_Name = "Calc_Entropy"

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


Option Explicit

Public Sub Calculate_Entropy(ByteArray() As Byte)
    Dim Entropy As Double
    Dim CharCount(255) As Long
    Dim X As Long
    Dim Prob As Double
    Dim PacLen As Double
    Dim TotFreq As Long
    TotFreq = UBound(ByteArray) + 1
    Entropy = 0
    For X = 0 To UBound(ByteArray)
        CharCount(ByteArray(X)) = CharCount(ByteArray(X)) + 1
    Next
    PacLen = 0
    For X = 0 To 255
        PacLen = PacLen - CharCount(X) * Log2(CharCount(X) / TotFreq)
    Next
    Entropy = PacLen / TotFreq
    PacLen = CLng(PacLen / 8)
    MsgBox "Entropy = " & Format(Entropy, "0.00") & " bits per byte" & Chr(13) & "Minimum filelengt = " & PacLen & " bytes"
End Sub

Public Function Log2(p)
    If p = 0 Then
        Log2 = 0
    Else
        Log2 = Log(p) / Log(2)
    End If
End Function