📄 cencdec.cls
字号:
End If
Next IxMask, Pointer
Decrypt = Decrypt & Chunk
Speed = Len(Decrypt) * 1000 / (GetTickCount - StartTick)
Class_Terminate
End Function
Private Sub DigestBlock(Data As String)
'MD5 mangle, requires a string of length 64
Dim IxBlock, Packed(0 To 15)
Dim a, b, c, d
'pack 4 bytes into 1 long
For IxBlock = 1 To BlockSize Step 4
Packed(IxBlock \ 4) = RotateLeft(RotateLeft(RotateLeft(Asc(Mid$(Data, IxBlock + 3, 1)), 8) Or Asc(Mid$(Data, IxBlock + 2, 1)), 8) Or Asc(Mid$(Data, IxBlock + 1, 1)), 8) Or Asc(Mid$(Data, IxBlock, 1))
Next IxBlock
With Digest
'Pass 1 digest
a = Pass1(.P(1), .P(2), .P(3), .P(4), Packed(0), S101, A101)
d = Pass1(.P(4), a, .P(2), .P(3), Packed(1), S102, A102)
c = Pass1(.P(3), d, a, .P(2), Packed(2), S103, A103)
b = Pass1(.P(2), c, d, a, Packed(3), S104, A104)
a = Pass1(a, b, c, d, Packed(4), S101, A105)
d = Pass1(d, a, b, c, Packed(5), S102, A106)
c = Pass1(c, d, a, b, Packed(6), S103, A107)
b = Pass1(b, c, d, a, Packed(7), S104, A108)
a = Pass1(a, b, c, d, Packed(8), S101, A109)
d = Pass1(d, a, b, c, Packed(9), S102, A110)
c = Pass1(c, d, a, b, Packed(10), S103, A111)
b = Pass1(b, c, d, a, Packed(11), S104, A112)
a = Pass1(a, b, c, d, Packed(12), S101, A113)
d = Pass1(d, a, b, c, Packed(13), S102, A114)
c = Pass1(c, d, a, b, Packed(14), S103, A115)
b = Pass1(b, c, d, a, Packed(15), S104, A116)
'Pass 2 digest
a = Pass2(a, b, c, d, Packed(1), S201, A201)
d = Pass2(d, a, b, c, Packed(6), S202, A202)
c = Pass2(c, d, a, b, Packed(11), S203, A203)
b = Pass2(b, c, d, a, Packed(0), S204, A204)
a = Pass2(a, b, c, d, Packed(5), S201, A205)
d = Pass2(d, a, b, c, Packed(10), S202, A206)
c = Pass2(c, d, a, b, Packed(15), S203, A207)
b = Pass2(b, c, d, a, Packed(4), S204, A208)
a = Pass2(a, b, c, d, Packed(9), S201, A209)
d = Pass2(d, a, b, c, Packed(14), S202, A210)
c = Pass2(c, d, a, b, Packed(3), S203, A211)
b = Pass2(b, c, d, a, Packed(8), S204, A212)
a = Pass2(a, b, c, d, Packed(13), S201, A213)
d = Pass2(d, a, b, c, Packed(2), S202, A214)
c = Pass2(c, d, a, b, Packed(7), S203, A215)
b = Pass2(b, c, d, a, Packed(12), S204, A216)
'Pass 3 digest
a = Pass3(a, b, c, d, Packed(5), S301, A301)
d = Pass3(d, a, b, c, Packed(8), S302, A302)
c = Pass3(c, d, a, b, Packed(11), S303, A303)
b = Pass3(b, c, d, a, Packed(14), S304, A304)
a = Pass3(a, b, c, d, Packed(1), S301, A305)
d = Pass3(d, a, b, c, Packed(4), S302, A306)
c = Pass3(c, d, a, b, Packed(7), S303, A307)
b = Pass3(b, c, d, a, Packed(10), S304, A308)
a = Pass3(a, b, c, d, Packed(13), S301, A309)
d = Pass3(d, a, b, c, Packed(0), S302, A310)
c = Pass3(c, d, a, b, Packed(3), S303, A311)
b = Pass3(b, c, d, a, Packed(6), S304, A312)
a = Pass3(a, b, c, d, Packed(9), S301, A313)
d = Pass3(d, a, b, c, Packed(12), S302, A314)
c = Pass3(c, d, a, b, Packed(15), S303, A315)
b = Pass3(b, c, d, a, Packed(2), S304, A316)
'Pass 4 digest
a = Pass4(a, b, c, d, Packed(0), S401, A401)
d = Pass4(d, a, b, c, Packed(7), S402, A402)
c = Pass4(c, d, a, b, Packed(14), S403, A403)
b = Pass4(b, c, d, a, Packed(5), S404, A404)
a = Pass4(a, b, c, d, Packed(12), S401, A405)
d = Pass4(d, a, b, c, Packed(3), S402, A406)
c = Pass4(c, d, a, b, Packed(10), S403, A407)
b = Pass4(b, c, d, a, Packed(1), S404, A408)
a = Pass4(a, b, c, d, Packed(8), S401, A409)
d = Pass4(d, a, b, c, Packed(15), S402, A410)
c = Pass4(c, d, a, b, Packed(6), S403, A411)
b = Pass4(b, c, d, a, Packed(13), S404, A412)
a = Pass4(a, b, c, d, Packed(4), S401, A413)
d = Pass4(d, a, b, c, Packed(11), S402, A414)
c = Pass4(c, d, a, b, Packed(2), S403, A415)
b = Pass4(b, c, d, a, Packed(9), S404, A416)
.P(1) = UnsignedAdd(.P(1), a, 0, 0)
.P(2) = UnsignedAdd(.P(2), b, 0, 0)
.P(3) = UnsignedAdd(.P(3), c, 0, 0)
.P(4) = UnsignedAdd(.P(4), d, 0, 0)
End With 'DIGEST
End Sub
Public Function Encrypt(Data As String, Key As String) As String
Attribute Encrypt.VB_Description = "Here the created codes are used to build the output bit stream"
'here the created codes are used to build the output bit stream
Dim Pointer, IxCode, Bits, Code As String, Chunk As String
StartTick = GetTickCount - 1 ' (-1) to prevent zero division
CreateCodes CreateTree(Key)
'encrypt data
Bits = 1 'marker bit
For Pointer = 1 To Len(Data)
IxCode = Asc(Mid$(Data, Pointer, 1)) Xor Hash
Code = Codes(IxCode)
Hash = IxCode \ 2 + Rnd * 128
#If Debugging Then
fTest.lstCodes.AddItem Mid$(Data, Pointer, 1) & " = " & Code & " (" & Len(Code) & ")"
#End If
For IxCode = 1 To Len(Code)
Bits = Bits * 2
If Mid$(Code, IxCode, 1) = "1" Then
Bits = Bits + 1
End If
If Bits > Bot8Bits Then
Chunk = Chunk & Chr$(Bits And Bot8Bits) 'append 8 encrypted bits
Bits = 1 'marker bit
End If
If Len(Chunk) = ChunkSize Then
Encrypt = Encrypt & Chunk 'append chunk
Chunk = vbNullString
End If
Next IxCode, Pointer
If Bits > 1 Then 'append remaining bits and slack bits
#If Debugging Then
Code = ""
#End If
Do
Bits = Bits * 2
If Left$(Codes(IxSlack), 1) = "1" Then
Bits = Bits + 1
#If Debugging Then
Code = Code & "1"
Else 'NOT LEFT$(CODES(IXSLACK),...
Code = Code & "0"
#End If
End If
Codes(IxSlack) = Mid$(Codes(IxSlack), 2) 'don't need code no more after this, can destroy
Loop Until Bits > Bot8Bits
#If Debugging Then
fTest.lstCodes.AddItem "[slack] = " & Code & " (" & Len(Code) & ")"
#End If
Chunk = Chunk & Chr$(Bits And Bot8Bits)
End If
Encrypt = Encrypt & Chunk
Speed = Len(Data) * 1000 / (GetTickCount - StartTick)
Class_Terminate
End Function
Public Property Get LastSignature(Length As SignatureLength) As String
LastSignature = Switch(Length = [Short], myMsgDigest4, Length = [Medium], myMsgDigest16, Length = [Long], myMsgDigest32, True, "")
If LastSignature = "" Then
Err.Raise 1003, , "Signature Lenght " & Length & " is not available."
End If
End Property
Public Property Get MaxCodeLength() As Long
Attribute MaxCodeLength.VB_Description = "Tree property: longest path from root to leaf"
'returns path length from root to farthest leaf
MaxCodeLength = MaxLen
End Property
Public Property Get MinCodeLength() As Long
Attribute MinCodeLength.VB_Description = "Tree property: shortest path from root to leaf"
'returns path length from root to nearest leaf
MinCodeLength = MinLen
End Property
Private Function Pass1(a As Long, b As Long, c As Long, d As Long, x As Long, s As Long, Ac As Long) As Long
Pass1 = UnsignedAdd(RotateLeft(UnsignedAdd(a, (b And c) Or (d And Not (b)), x, Ac), s), b, 0, 0)
End Function
Private Function Pass2(a As Long, b As Long, c As Long, d As Long, x As Long, s As Long, Ac As Long) As Long
Pass2 = UnsignedAdd(RotateLeft(UnsignedAdd(a, (b And d) Or (c And Not (d)), x, Ac), s), b, 0, 0)
End Function
Private Function Pass3(a As Long, b As Long, c As Long, d As Long, x As Long, s As Long, Ac As Long) As Long
Pass3 = UnsignedAdd(RotateLeft(UnsignedAdd(a, b Xor c Xor d, x, Ac), s), b, 0, 0)
End Function
Private Function Pass4(a As Long, b As Long, c As Long, d As Long, x As Long, s As Long, Ac As Long) As Long
Pass4 = UnsignedAdd(RotateLeft(UnsignedAdd(a, c Xor (b Or Not (d)), x, Ac), s), b, 0, 0)
End Function
Private Function RotateLeft(ByVal Value As Long, ByVal NumPlaces As Long) As Long
'rotate a long numplaces to the left
Dim CntPlaces, SpillOver
For CntPlaces = 1 To NumPlaces Mod 32
SpillOver = Value And &HC0000000
Value = (Value And &H3FFFFFFF) * 2 Or ((SpillOver < 0) And 1) Or (CBool(SpillOver And &H40000000) And &H80000000)
Next CntPlaces
RotateLeft = Value
End Function
#If Debugging Then
Private Sub ShowNodeWithChildren(IxParent As Long, IxNode As Long, ChildNum As String, Coding As String)
'show a graphic representation of the tree
Dim PKey As String, CKey As String
PKey = "K" & IxParent
CKey = "K" & IxNode
With fTest.tvwTree.Nodes
If IxParent < 0 Then
.Add(, , CKey, IxNode, "Root").Expanded = False
Else 'NOT IXPARENT...
If Nodes(IxNode).Child1 Then
.Add(PKey, tvwChild, CKey, IxNode & " (C" & ChildNum & " of " & IxParent & ")", "Node").Expanded = True
Else 'NODES(IXNODE).CHILD1 = FALSE
.Add(PKey, tvwChild, CKey, IxNode & " (C" & ChildNum & " of " & IxParent & ")" & " = " & Coding, "Leaf").Expanded = True
End If
End If
End With 'FTEST.TVWTREE.NODES
With Nodes(IxNode)
If .Child1 Then
ShowNodeWithChildren IxNode, .Child1, "1", Coding & "0"
End If
If .Child2 Then
ShowNodeWithChildren IxNode, .Child2, "2", Coding & "1"
End If
End With 'NODES(IXNODE)
End Sub
#End If
Public Function Signature(Reset As Boolean, Data As String, LenSignature As SignatureLength) As String
Attribute Signature.VB_Description = "Digest a string and output the result as a string or a hex string"
'digest a string and output the result as a string
'this can be called several times in a row, for very long texts which have to be split
'first call for must reset, subsequent calls must not
Dim ip, Padding As String
With Digest
If Reset Then
'initialize the algorithm
.P(1) = ToUnsignedLong(IniPart1)
.P(2) = ToUnsignedLong(IniPart2)
.P(3) = ToUnsignedLong(IniPart3)
.P(4) = ToUnsignedLong(IniPart4)
End If
'create pseudo random padding
Padding = Mid$(Data, (Len(Data) + 1) \ 2, 1)
Do
Padding = Mid$(Data, Asc(Padding) Mod Len(Data) + 1, 1) & Padding
Loop Until Len(Padding) = BlockSize - 1
'digest the stuff in chunks
For ip = 1 To Len(Data) Step BlockSize
DigestBlock Mid$(Data & Padding, ip, BlockSize)
Next ip
'make three different signatures:
'4 bytes
ip = .P(1) Xor .P(2) Xor .P(3) Xor .P(4)
myMsgDigest4 = Chr$(ip And Bot8Bits) & Chr$(ip \ 256 And Bot8Bits) & Chr$(ip \ 256 \ 256 And Bot8Bits) & Chr$(ip \ 256 \ 256 \ 256 And Bot8Bits)
'16 bytes
myMsgDigest16 = ""
For ip = 0 To 3
myMsgDigest16 = myMsgDigest16 & Chr$(.P(1) \ 256 ^ ip And Bot8Bits) & Chr$(.P(2) \ 256 ^ ip And Bot8Bits) & Chr$(.P(3) \ 256 ^ ip And Bot8Bits) & Chr$(.P(4) \ 256 ^ ip And Bot8Bits)
Next ip
'32 bytes
myMsgDigest32 = LCase$(Right$("0000000" & Hex$(.P(1)), 8) & Right$("0000000" & Hex$(.P(2)), 8) & Right$("0000000" & Hex$(.P(3)), 8) & Right$("0000000" & Hex$(.P(4)), 8))
End With 'DIGEST
Select Case LenSignature 'which should I return
Case [Short]
Signature = myMsgDigest4
Case [Medium]
Signature = myMsgDigest16
Case [Long]
Signature = myMsgDigest32
Case Else
Signature = ""
Err.Raise 1003, , "Signature Lenght " & LenSignature & " is not available."
End Select
End Function
Private Function ToUnsignedLong(Value As Double) As Long
'convert a double to an unsigned long
Const Over As Double = 2 ^ 32
If Value <= MaxLong Then
ToUnsignedLong = Value
Else 'NOT VALUE...
ToUnsignedLong = Value - Over
End If
End Function
Private Function UnsignedAdd(Summand1 As Long, Summand2 As Long, Summand3 As Long, Summand4 As Long) As Long
'adds four unsigned numbers together, overflows are ignored
Dim Low, High
Low = (Summand1 And Bot16Bits) + (Summand2 And Bot16Bits) + (Summand3 And Bot16Bits) + (Summand4 And Bot16Bits)
High = ((Summand1 And Top16Bits) \ Bit16Only + (Summand2 And Top16Bits) \ Bit16Only + (Summand3 And Top16Bits) \ Bit16Only + (Summand4 And Top16Bits) \ Bit16Only + Low \ Bit16Only) And Bot16Bits
UnsignedAdd = ToUnsignedLong(CDbl(High) * Bit16Only + (Low And Bot16Bits))
End Function
Public Property Get Version() As String
Version = "2.0.17, dated Feb 06, 2002"
End Property
':) Ulli's VB Code Formatter V2.9.4 (06.02.2002 12:44:58) 310 + 542 = 852 Lines
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -