' --------------------------------------------------------------------------------
' Code generated automatically by Code Architects' VB Migration Partner
' --------------------------------------------------------------------------------
Option Strict Off ' Code migrated from VB6 has Option Strict disabled by default
Friend Class Cls_Encrypt
#Region "Constructor"
'A public default constructor
Public Sub New()
Class_Initialize_VB6()
' Add initialization code here
End Sub
#End Region
'This module is created by John Korejwa
Private Key0 As Integer 'Zip Encryption Keys
Private Key1(3) As Integer 'Key1(0-3) = LSB to MSB of Key1
Private Key2 As Integer
Private Key1Mul(3) As Integer 'Multiplier (constant) used in update_keys
Private Key1Tmp(3) As Integer 'Temp for intermediate Key1
Private CRC As New Cls_CRC32
'ZIP Decryption/Encryption
Private Function decrypt_byte() As Integer
Dim i As Integer
Dim j As Integer
i = (Key2 And 255%) Or 2%
j = (Key2 And &HFF00%)
Return (((i Xor 1%) * (i + j) + i * j) And &HFF00%) \ 256%
End Function
Private Sub update_keys(ByVal TheChar As Integer)
Dim i As Integer
Dim j As Integer
Dim reg As Integer
Key0 = (((Key0 And &HFFFFFF00) \ &H100%) And &HFFFFFF) Xor (CRC.GetcrcTable((Key0 And &HFF%) Xor TheChar))
reg = (Key0 And 255%) 'Key1Tmp = Key1 + (Key0 And 255)
For i = 0 To 3
reg += Key1(i)
Key1Tmp(i) = reg And 255%
reg \= 256%
Key1(i) = 0%
Next
Key1(0) = 1 'Key1 = 1 + Key1Tmp * Key1Mul
For i = 0 To 3
reg = 0
For j = 0 To 3 - i
reg = reg + Key1(i + j) + Key1Tmp(i) * Key1Mul(j)
Key1(i + j) = reg And 255%
reg \= 256%
Next
Next
Key2 = (((Key2 And &HFFFFFF00) \ &H100%) And &HFFFFFF) Xor (CRC.GetcrcTable((Key2 And &HFF%) Xor Key1(3)))
End Sub
Public Sub ZipPrepareKey(ByRef Data() As Byte, ByVal PassWord As String)
Dim C As Integer
Dim i As Integer
'Initialize Keys
Key0 = &H12345678
Key1(3) = &H23
Key1(2) = &H45
Key1(1) = &H67
Key1(0) = &H89
Key2 = &H34567890
'Prepare Keys with password
For i = 0 To Len6(PassWord) - 1
C = Asc(Mid(PassWord, i + 1, 1))
update_keys(C)
Next
'Crypt 12 byte header
For i = 0 To 11
C = Data(i) Xor decrypt_byte()
update_keys(C)
Data(i) = C
Next
End Sub
Public Sub ZipDecryptArray(ByRef Data() As Byte)
Dim i As Integer
Dim C As Integer
Dim Min As Integer
Dim Max As Integer
Min = LBound6(Data)
Max = UBound6(Data)
For i = Min To Max
C = Data(i) Xor decrypt_byte()
update_keys(C)
Data(i) = C
Next
End Sub
Public Sub ZipEncryptArray(ByRef Data() As Byte, ByVal PassWord As String, ByVal CRC32 As Integer)
Dim C As Integer 'This procedure Not Tested
Dim i As Integer
Dim j As Integer
Dim Max As Integer
'Shift data 12 bytes, to make room for encryption header
ReDim Preserve Data(UBound6(Data) + 12)
Max = UBound6(Data)
For i = Max To 12 Step -1 ' CopyMemory data(12), data(0), UBound(data) - 11
Data(i) = Data(i - 12)
Next
'Fill first 11 bytes with random data, 12th byte with the MSB of the crc32 value
Randomize(Timer6)
For i = 0 To 10
j = CInt((Max - 11) * Rnd() + 12)
Data(i) = Data(j) Xor Int(256 * Rnd())
Next
j = 0
For i = 0 To 10
j = (j + Asc(Mid(PassWord, (i Mod Len6(PassWord)) + 1, 1))) Mod 11
C = Data(i)
Data(i) = Data(j)
Data(j) = C
Next
Data(11) = ((CRC32 And &HFF000000) \ &H1000000) And 255%
ZipPrepareKey(Data, PassWord)
'Encrypt the data
For i = 12 To UBound6(Data)
C = Data(i) Xor decrypt_byte()
update_keys(C)
Data(i) = C
Next
End Sub
Private Sub Class_Initialize_VB6()
Key1Mul(3) = &H8
Key1Mul(2) = &H8
Key1Mul(1) = &H84
Key1Mul(0) = &H5
End Sub
End Class