]
07-09-2014, 10:27 PM
Crypter used in writing the best encoding mAlArdAn one example, you took many hours did you 35/0 bi cryptor udla after you've b crypt Did you have looked results 35/8 was 35/10 became so your all your efforts wasted Encryption Modulein this case strongly recommend only using I bi algo is the knowing use for those new to If the request can I make anat, the best use ...
PHP Code:
cOption Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetProvParam Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwParam As Long, ByRef pbData As Any, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal HKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal HKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal HKey As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal HKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Const SERVICE_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
Private Const PP_NAME As Long = 4
Private Const PP_CONTAINER As Long = 6
Private Const CRYPT_NEWKEYSET As Long = 8
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 As Long = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM As Long = CALG_RC4
Private Const ENCRYPT_NUMBERKEY As String = "16006833"
Private lngCryptProvider As Long
Private avarSeedValues ??As Variant
Private lngSeedLevel As Long
Private lngDecryptPointer As Long
Private astrEncryptionKey(0 To 131) As String
Private Const lngALPKeyLength As Long = 8
Public strKeyContainer As String
Public Function DecryptWithALP(strData As String) As String
Dim strALPKey As String
Dim As String strALPKeyMask
Dim lngIterator As Long
Dim blnOscillator As Boolean
Dim strOutput As String
Dim lngHex As Long
If Len(strData) = 0 Then
Exit Function
End If
strALPKeyMask = Right$(String$(lngALPKeyLength, "0") + DoubleToBinary(CLng("&H" + Left$(strData, 2))), lngALPKeyLength)
strData = Right $ (strData, Len (strData) - 2)
For lngIterator = lngALPKeyLength To 1 Step -1
If Mid$(strALPKeyMask, lngIterator, 1) = "1" Then
strALPKey = Left$(strData, 1) + strALPKey
strData = Right $ (strData, Len (strData) - 1)
Else
strALPKey = Right$(strData, 1) + strALPKey
strData = Left $ (strData, Len (strData) - 1)
End If
Next lngIterator
lngIterator = 0
Do Until Len (strData) = 0
blnOscillator = Not blnOscillator
lngIterator = lngIterator + 1
If lngIterator > lngALPKeyLength Then
lngIterator = 1
End If
lngHex = IIf (blnOscillator, CLng ("& H" + Left $ (strData, 2) - Asc (Mid $ (strALPKey, lngIterator, 1))), CLng ("& H" + Left $ (strData, 2) + Asc ( Mid $ (strALPKey, lngIterator, 1))))
If lngHex > 255 Then
lngHex = lngHex - 255
ElseIf lngHex < 0 Then
lngHex = lngHex + 255
End If
strOutput = strOutput + Chr$(lngHex)
strData = Right $ (strData, Len (strData) - 2)
Loop
DecryptWithALP = strOutput
End Function
Public Function DecryptWithClipper(ByVal strData As String, ByVal strCryptKey As String) As String
Dim strDecryptionChunk As String
Dim strDecryptedText As String
On Error Resume Next
InitCrypt strCryptKey
Do Until Len (strData) <16
strDecryptionChunk = ""
strDecryptionChunk = Left$(strData, 16)
strData = Right $ (strData, Len (strData) - 16)
If Len(strDecryptionChunk) > 0 Then
strDecryptedText = strDecryptedText + PerformClipperDecryption(strDecryptionChunk)
End If
Loop
DecryptWithClipper = strDecryptedText
End Function
Public Function DecryptWithCSP(ByVal strData As String, ByVal strCryptKey As String) As String
Dim lngEncryptionCount As Long
Dim strDecrypted As String
Dim strCurrentCryptKey As String
If EncryptionCSPConnect() Then
lngEncryptionCount = DecryptNumber(Mid$(strData, 1, 8))
strCurrentCryptKey = strCryptKey & lngEncryptionCount
strDecrypted = EncryptDecrypt(Mid$(strData, 9), strCurrentCryptKey, False)
DecryptWithCSP = strDecrypted
EncryptionCSPDisconnect
End If
End Function
Public Function EncryptWithALP(strData As String) As String
Dim strALPKey As String
Dim As String strALPKeyMask
Dim lngIterator As Long
Dim blnOscillator As Boolean
Dim strOutput As String
Dim lngHex As Long
If Len(strData) = 0 Then
Exit Function
End If
Randomize
For lngIterator = 1 To lngALPKeyLength
strALPKey = strALPKey + Trim$(Hex$(Int(16 * Rnd)))
strALPKeyMask strALPKeyMask + = Trim $ (Int (2 * Rnd))
Next lngIterator
lngIterator = 0
Do Until Len (strData) = 0
blnOscillator = Not blnOscillator
lngIterator = lngIterator + 1
If lngIterator > lngALPKeyLength Then
lngIterator = 1
End If
lngHex = IIf (blnOscillator, CLng (Asc (Left $ (strData, 1)) + Asc (Mid $ (strALPKey, lngIterator, 1))), CLng (Asc (Left $ (strData, 1)) - Asc (Mid $ (strALPKey, lngIterator, 1))))
If lngHex > 255 Then
lngHex = lngHex - 255
ElseIf lngHex < 0 Then
lngHex = lngHex + 255
End If
strOutput = strOutput + Right$(String$(2, "0") + Hex$(lngHex), 2)
strData = Right $ (strData, Len (strData) - 1)
Loop
For lngIterator = 1 To lngALPKeyLength
If Mid$(strALPKeyMask, lngIterator, 1) = "1" Then
strOutput = Mid$(strALPKey, lngIterator, 1) + strOutput
Else
strOutput = strOutput + Mid$(strALPKey, lngIterator, 1)
End If
Next lngIterator
EncryptWithALP = Right$(String$(2, "0") + Hex$(BinaryToDouble(strALPKeyMask)), 2) + strOutput
End Function
Public Function EncryptWithClipper(ByVal strData As String, ByVal strCryptKey As String) As String
Dim strEncryptionChunk As String
Dim strEncryptedText As String
If Len(strData) > 0 Then
InitCrypt strCryptKey
Do Until Len (strData) = 0
strEncryptionChunk = ""
If Len(strData) > 6 Then
strEncryptionChunk = Left$(strData, 6)
strData = Right $ (strData, Len (strData) - 6)
Else
strEncryptionChunk = Left$(strData + Space(6), 6)
strData = ""
End If
If Len(strEncryptionChunk) > 0 Then
strEncryptedText = strEncryptedText + PerformClipperEncryption(strEncryptionChunk)
End If
Loop
End If
EncryptWithClipper = strEncryptedText
End Function
Public Function EncryptWithCSP(ByVal strData As String, ByVal strCryptKey As String) As String
Dim strEncrypted As String
Dim lngEncryptionCount As Long
Dim strCurrentCryptKey As String
If EncryptionCSPConnect() Then
lngEncryptionCount = 0
strCurrentCryptKey = strCryptKey & lngEncryptionCount
strEncrypted = EncryptDecrypt(strData, strCurrentCryptKey, True)
Do While (InStr(1, strEncrypted, vbCr) > 0) Or (InStr(1, strEncrypted, vbLf) > 0) Or (InStr(1, strEncrypted, Chr$(0)) > 0) Or (InStr(1, strEncrypted, vbTab) > 0)
lngEncryptionCount = lngEncryptionCount + 1
strCurrentCryptKey = strCryptKey & lngEncryptionCount
strEncrypted = EncryptDecrypt(strData, strCurrentCryptKey, True)
DM = 99999999 Then lngEncryptionCount
Err.Raise vbObjectError + 999, "EncryptWithCSP", "This Data cannot be successfully encrypted"
EncryptWithCSP = ""
Exit Function
End If
Loop
EncryptWithCSP = EncryptNumber(lngEncryptionCount) & strEncrypted
EncryptionCSPDisconnect
End If
End Function
Public Function GetCSPDetails() As String
Dim lngDataLength As Long
Dim bytContainer() As Byte
If EncryptionCSPConnect Then
If lngCryptProvider = 0 Then
GetCSPDetails = "Not connected to CSP"
Exit Function
End If
lngDataLength = 1000
ReDim bytContainer(lngDataLength)
If CryptGetProvParam(lngCryptProvider, PP_NAME, bytContainer(0), lngDataLength, 0) <> 0 Then
GetCSPDetails = "Cryptographic Service Provider name: " & ByteToString(bytContainer, lngDataLength)
End If
lngDataLength = 1000
ReDim bytContainer(lngDataLength)
If CryptGetProvParam(lngCryptProvider, PP_CONTAINER, bytContainer(0), lngDataLength, 0) <> 0 Then
GetCSPDetails = GetCSPDetails & vbCrLf & "Key Container name: " & ByteToString(bytContainer, lngDataLength)
End If
EncryptionCSPDisconnect
Else
GetCSPDetails = "Not connected to CSP"
End If
End Function
Private Function DecryptNumber(ByVal strData As String) As Long
Dim lngIterator As Long
For lngIterator = 1 To 8
DecryptNumber = (10 * DecryptNumber) + (Asc(Mid$(strData, lngIterator, 1)) - Asc(Mid$(ENCRYPT_NUMBERKEY, lngIterator, 1)))
Next lngIterator
End Function
Private Function EncryptDecrypt(ByVal strData As String, ByVal strCryptKey As String, ByVal Encrypt As Boolean) As String
Dim lngDataLength As Long
Dim strTempData As String
Dim lngHaslngCryptKey As Long
Dim lngCryptKey As Long
If lngCryptProvider = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Not connected to CSP"
Exit Function
End If
If CryptCreateHash(lngCryptProvider, CALG_MD5, 0, 0, lngHaslngCryptKey) = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Error during CryptCreateHash."
End If
If CryptHashData(lngHaslngCryptKey, strCryptKey, Len(strCryptKey), 0) = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Error during CryptHashData."
End If
If CryptDeriveKey(lngCryptProvider, ENCRYPT_ALGORITHM, lngHaslngCryptKey, 0, lngCryptKey) = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Error during CryptDeriveKey!"
End If
strTempData = strData
lngDataLength = Len (strData)
If Encrypt Then
If CryptEncrypt(lngCryptKey, 0, 1, 0, strTempData, lngDataLength, lngDataLength) = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Error during CryptEncrypt."
End If
Else
If CryptDecrypt(lngCryptKey, 0, 1, 0, strTempData, lngDataLength) = 0 Then
Err.Raise vbObjectError + 999, "EncryptDecrypt", "Error during CryptDecrypt."
End If
End If
EncryptDecrypt = Mid$(strTempData, 1, lngDataLength)
If lngCryptKey <> 0 Then
CryptDestroyKey lngCryptKey
End If
If lngHaslngCryptKey <> 0 Then
CryptDestroyHash lngHaslngCryptKey
End If
End Function
Private Function EncryptionCSPConnect() As Boolean
If Len(strKeyContainer) = 0 Then
strKeyContainer = "FastTrack"
End If
If CryptAcquireContext(lngCryptProvider, strKeyContainer, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0 Then
If CryptAcquireContext(lngCryptProvider, strKeyContainer, SERVICE_PROVIDER, PROV_RSA_FULL, 0) = 0 Then
Err.Raise vbObjectError + 999, "EncryptionCSPConnect", "Error during CryptAcquireContext for a new key container." & vbCrLf & "A container with this name probably already exists."
EncryptionCSPConnect = False
Exit Function
End If
End If
EncryptionCSPConnect = True
End Function
Private Function EncryptNumber(ByVal lngData As Long) As String
Dim lngIterator As Long
Dim strData As String
strData = Format $ (lngData, "00000000")
For lngIterator = 1 To 8
EncryptNumber = EncryptNumber & Chr$(Asc(Mid$(ENCRYPT_NUMBERKEY, lngIterator, 1)) + Val(Mid$(strData, lngIterator, 1)))
Next lngIterator
End Function
Private Sub EncryptionCSPDisconnect()
If lngCryptProvider <> 0 Then
CryptReleaseContext lngCryptProvider, 0
End If
End Sub
Private Sub InitCrypt(ByRef strEncryptionKey As String)
avarSeedValues ??= Array ("A3", "D7", "09", "83", "F8", "48", "F6", "F4", "B3", "21", "15", "78 "," 99 "," B1 "," AF ", _
"F9", "E7", "2D", "4D", "8A", "CE", "4C", "CA", "2E", "52", "95", "D9", "1E "," 4e "," 38 "," 44 "," 28 "," 0A "," DF ", _
"02", "A0", "17", "F1", "60", "68", "12", "B7", "7A", "C3", "E9", "FA", "3D "," 53 "," 96 "," 84 "," 6B "," BA "," F2 ", _
"63", "9A", "19", "7c", "AE", "E5", "F5", "f7", "16", "6a", "A2", "39", "B6 "," 7B "," 0f "," C1 "," 93 "," 81 "," 1B ",, _
"EE", "B4", "1A", "EA", "D0", "91", "2F", "B8", "55", "B9", "DA", "85", "3F "," 41 "," BF "," e0 "," 5A "," 58 "," 80 ", _
"5F", "66", "0B", "D8", "90", "35", "D5", "C0", "A7", "33", "06", "65", "69 "," 45 "," 00 "," 94 "," 56 "," 6D "," 98 ", _
"9B", "76", "97", "FC", "B2", "C2", "B0", "FE", "DB", "20", "E1", "EB", "D6 "," E4 "," DD "," 47 "," 4A "," 1D "," 42 ", _
"ED", "9E", "6e", "49", "3C", "400", "43", "27", "D2", "07", "D4", "THE", "C7 "," 67 "," 18 "," 89 "," CB "," 30 "," 1F ", _
"8D", "G6", "8f", "AA", "C8", "74", "600", "C9", "5D", "5C", "31", "A4", "70 "," 88 "," 61 "," 2C "," 9F "," 0D "," 2B ", _
"87", "50", "82", "54", "64", "26", "7D", "03", "40", "34", "4B", "1C", "73 "," D1 "," C4 "," FD "," 3B "," CC "," FB ", _
"7F", "AB", "E6", "3E", "5B", "A5", "TO", "04", "23", "9c", "14", "51", "22 "," F0 "," 29 "," 79 "," 71 "," 7E "," FF ", _
"8c", "0E", "E2", "0C", "EF", "BC", "72", "75", "6f", "37", "A1", "EC", "d3 "," 8E "," 62 "," 8B "," 86 "," 10 "," E8 ", _
"08", "77", "11", "BE", "92", "4F", "24", "C5", "32", "36", "9D", "CF", "F3 "," A6 "," BB "," AC "," 5E "," 6C "," A9 ", _
"13", "57", "25", "B5", "E3", "BD", "A8", "3A", "01", "05", "59", "2A", "46 ")
SetKey strEncryptionKey
End Sub
Private Function PerformClipperDecryption(ByVal strData As String) As String
Dim bytChunk(1 To 4, 0 To 32) As String
Dim bytCounter(0 To 32) As Byte
Dim lngIterator As Long
Dim strDecryptedData As String
On Error Resume Next
bytChunk (1, 32) = Mid (strData, 1, 4)
bytChunk (2, 32) = Mid (strData, 5, 4)
bytChunk (3, 32) = Mid (strData, 9, 4)
bytChunk (4, 32) = Mid (strData, 13, 4)
lngSeedLevel = 32
lngDecryptPointer = 31
For lngIterator = 0 To 32
bytCounter(lngIterator) = lngIterator + 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel - 1) = PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey())
bytChunk(2, lngSeedLevel - 1) = PerformXOR(PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey()), PerformXOR(bytChunk(3, lngSeedLevel), Hex(bytCounter(lngSeedLevel - 1))))
bytChunk (3, lngSeedLevel - 1) = bytChunk (4, lngSeedLevel)
bytChunk (4, lngSeedLevel - 1) = bytChunk (1, lngSeedLevel)
lngDecryptPointer = lngDecryptPointer - 1
lngSeedLevel = lngSeedLevel - 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel - 1) = PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey())
bytChunk (2, lngSeedLevel - 1) = bytChunk (3, lngSeedLevel)
bytChunk (3, lngSeedLevel - 1) = bytChunk (4, lngSeedLevel)
bytChunk(4, lngSeedLevel - 1) = PerformXOR(PerformXOR(bytChunk(1, lngSeedLevel), bytChunk(2, lngSeedLevel)), Hex(bytCounter(lngSeedLevel - 1)))
lngDecryptPointer = lngDecryptPointer - 1
lngSeedLevel = lngSeedLevel - 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel - 1) = PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey())
bytChunk(2, lngSeedLevel - 1) = PerformXOR(PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey()), PerformXOR(bytChunk(3, lngSeedLevel), Hex(bytCounter(lngSeedLevel - 1))))
bytChunk (3, lngSeedLevel - 1) = bytChunk (4, lngSeedLevel)
bytChunk (4, lngSeedLevel - 1) = bytChunk (1, lngSeedLevel)
lngDecryptPointer = lngDecryptPointer - 1
lngSeedLevel = lngSeedLevel - 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel - 1) = PerformClipperDecryptionChunk(bytChunk(2, lngSeedLevel), astrEncryptionKey())
bytChunk (2, lngSeedLevel - 1) = bytChunk (3, lngSeedLevel)
bytChunk (3, lngSeedLevel - 1) = bytChunk (4, lngSeedLevel)
bytChunk(4, lngSeedLevel - 1) = PerformXOR(PerformXOR(bytChunk(1, lngSeedLevel), bytChunk(2, lngSeedLevel)), Hex(bytCounter(lngSeedLevel - 1)))
lngDecryptPointer = lngDecryptPointer - 1
lngSeedLevel = lngSeedLevel - 1
Next lngIterator
strDecryptedData = HexToString (bytChunk (1, 0) & bytChunk (2, 0) & bytChunk (3, 0) & bytChunk (4, 0))
If InStr(strDecryptedData, Chr$(0)) > 0 Then
strDecryptedData = Left$(strDecryptedData, InStr(strDecryptedData, Chr$(0)) - 1)
End If
PerformClipperDecryption = strDecryptedData
End Function
Private Function PerformClipperDecryptionChunk(ByVal strData As String, ByRef strEncryptionKey() As String) As String
Dim astrDecryptionLevel(1 To 6) As String
Dim strDecryptedString As String
astrDecryptionLevel(5) = Mid(strData, 1, 2)
astrDecryptionLevel(6) = Mid(strData, 3, 2)
strDecryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrDecryptionLevel(5), strEncryptionKey((4 * lngDecryptPointer) + 3)))))
astrDecryptionLevel(4) = PerformXOR(strDecryptedString, astrDecryptionLevel(6))
strDecryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrDecryptionLevel(4), strEncryptionKey((4 * lngDecryptPointer) + 2)))))
astrDecryptionLevel(3) = PerformXOR(strDecryptedString, astrDecryptionLevel(5))
strDecryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrDecryptionLevel(3), strEncryptionKey((4 * lngDecryptPointer) + 1)))))
astrDecryptionLevel(2) = PerformXOR(strDecryptedString, astrDecryptionLevel(4))
strDecryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrDecryptionLevel(2), strEncryptionKey(4 * lngDecryptPointer)))))
astrDecryptionLevel(1) = PerformXOR(strDecryptedString, astrDecryptionLevel(3))
strDecryptedString = astrDecryptionLevel(1) & astrDecryptionLevel(2)
PerformClipperDecryptionChunk = strDecryptedString
End Function
Private Function PerformClipperEncryption(ByVal strData As String) As String
Dim bytChunk(1 To 4, 0 To 32) As String
Dim lngCounter As Long
Dim lngIterator As Long
On Error Resume Next
strData = StringToHex (strData)
bytChunk (1, 0) = Mid (strData, 1, 4)
bytChunk (2, 0) = Mid (strData, 5, 4)
bytChunk (3, 0) = Mid (strData, 9, 4)
bytChunk (4, 0) = Mid (strData, 13, 4)
lngSeedLevel = 0
lngCounter = 1
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel + 1) = PerformXOR(PerformXOR(PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey()), bytChunk(4, lngSeedLevel)), Hex(lngCounter))
bytChunk(2, lngSeedLevel + 1) = PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey())
bytChunk (3, lngSeedLevel + 1) = bytChunk (2, lngSeedLevel)
bytChunk (4, lngSeedLevel + 1) = bytChunk (3, lngSeedLevel)
lngCounter = lngCounter + 1
lngSeedLevel = lngSeedLevel + 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk (1, lngSeedLevel + 1) = bytChunk (4, lngSeedLevel)
bytChunk(2, lngSeedLevel + 1) = PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey())
bytChunk(3, lngSeedLevel + 1) = PerformXOR(PerformXOR(bytChunk(1, lngSeedLevel), bytChunk(2, lngSeedLevel)), Hex(lngCounter))
bytChunk (4, lngSeedLevel + 1) = bytChunk (3, lngSeedLevel)
lngCounter = lngCounter + 1
lngSeedLevel = lngSeedLevel + 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk(1, lngSeedLevel + 1) = PerformXOR(PerformXOR(PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey()), bytChunk(4, lngSeedLevel)), Hex(lngCounter))
bytChunk(2, lngSeedLevel + 1) = PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey())
bytChunk (3, lngSeedLevel + 1) = bytChunk (2, lngSeedLevel)
bytChunk (4, lngSeedLevel + 1) = bytChunk (3, lngSeedLevel)
lngCounter = lngCounter + 1
lngSeedLevel = lngSeedLevel + 1
Next lngIterator
For lngIterator = 1 To 8
bytChunk (1, lngSeedLevel + 1) = bytChunk (4, lngSeedLevel)
bytChunk(2, lngSeedLevel + 1) = PerformClipperEncryptionChunk(bytChunk(1, lngSeedLevel), astrEncryptionKey())
bytChunk(3, lngSeedLevel + 1) = PerformXOR(PerformXOR(bytChunk(1, lngSeedLevel), bytChunk(2, lngSeedLevel)), Hex(lngCounter))
bytChunk (4, lngSeedLevel + 1) = bytChunk (3, lngSeedLevel)
lngCounter = lngCounter + 1
lngSeedLevel = lngSeedLevel + 1
Next lngIterator
PerformClipperEncryption = bytChunk(1, 32) & bytChunk(2, 32) & bytChunk(3, 32) & bytChunk(4, 32)
End Function
Private Function PerformClipperEncryptionChunk(ByVal strData As String, ByRef strEncryptionKey() As String) As String
Dim astrEncryptionLevel(1 To 6) As String
Dim strEncryptedString As String
astrEncryptionLevel(1) = Mid(strData, 1, 2)
astrEncryptionLevel(2) = Mid(strData, 3, 2)
strEncryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrEncryptionLevel(2), strEncryptionKey(4 * lngSeedLevel)))))
astrEncryptionLevel(3) = PerformXOR(strEncryptedString, astrEncryptionLevel(1))
strEncryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrEncryptionLevel(3), strEncryptionKey((4 * lngSeedLevel) + 1)))))
astrEncryptionLevel(4) = PerformXOR(strEncryptedString, astrEncryptionLevel(2))
strEncryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrEncryptionLevel(4), strEncryptionKey((4 * lngSeedLevel) + 2)))))
astrEncryptionLevel(5) = PerformXOR(strEncryptedString, astrEncryptionLevel(3))
strEncryptedString = avarSeedValues(CByte(PerformTranslation(PerformXOR(astrEncryptionLevel(5), strEncryptionKey((4 * lngSeedLevel) + 3)))))
astrEncryptionLevel(6) = PerformXOR(strEncryptedString, astrEncryptionLevel(4))
strEncryptedString = astrEncryptionLevel(5) & astrEncryptionLevel(6)
PerformClipperEncryptionChunk = strEncryptedString
End Function
Private Function PerformTranslation(ByVal strData As String) As Double
Dim strTranslationString As String
Dim strTranslationChunk As String
Dim lngTranslationIterator As Long
Dim lngHexConversion As Long
Dim lngHexConversionIterator As Long
Dim dblTranslation As Double
Dim lngTranslationMarker As Long
Dim lngTranslationModifier As Long
Dim lngTranslationLayerModifier As Long
strTranslationString = strData
strTranslationString = Right$(strTranslationString, 8)
strTranslationChunk = String $ (8 - Len (strTranslationString), "0") + strTranslationString
strTranslationString = ""
For lngTranslationIterator = 1 To 8
lngHexConversion = Val ("& H" + Mid $ (strTranslationChunk, lngTranslationIterator, 1))
For lngHexConversionIterator = 3 To 0 Step -1
If lngHexConversion And 2 ^ lngHexConversionIterator Then
strTranslationString strTranslationString + = "1"
Else
strTranslationString strTranslationString + = "0"
End If
Next lngHexConversionIterator
Next lngTranslationIterator
dblTranslation = 0
For lngTranslationIterator = Len(strTranslationString) To 1 Step -1
If Mid(strTranslationString, lngTranslationIterator, 1) = "1" Then
lngTranslationLayerModifier = 1
lngTranslationMarker = (Len (strTranslationString) - lngTranslationIterator)
lngTranslationModifier = 2
Do While lngTranslationMarker > 0
Do While (lngTranslationMarker / 2) = (lngTranslationMarker \ 2)
lngTranslationModifier = (lngTranslationModifier * lngTranslationModifier) ??Mod 255
lngTranslationMarker = lngTranslationMarker / 2
Loop
lngTranslationLayerModifier = (lngTranslationModifier * lngTranslationLayerModifier) Mod 255
lngTranslationMarker = lngTranslationMarker - 1
Loop
dblTranslation = dblTranslation + lngTranslationLayerModifier
End If
Next lngTranslationIterator
Perform Translation = dblTranslation
End Function
Private Function PerformXOR(ByVal strData As String, ByVal strMask As String) As String
Dim strXOR As String
Dim lngXORIterator As Long
Dim lngXORMarker As Long
lngXORMarker = Len (strData) - Len (strMask)
If lngXORMarker < 0 Then
strXOR = Left $ (strMask, Abs (lngXORMarker))
strMask = Mid $ (strMask, Abs (lngXORMarker) + 1)
ElseIf lngXORMarker > 0 Then
strXOR = Left$(strData, Abs(lngXORMarker))
strData = Mid $ (strData, lngXORMarker + 1)
End If
For lngXORIterator = 1 To Len(strData)
strXOR = strXOR + Hex $ (Val ("& H" + Mid $ (strData, lngXORIterator, 1)) XOR Val ("& H" + Mid $ (strMask, lngXORIterator, 1)))
Next lngXORIterator
PerformXOR = Right(strXOR, 8)
End Function
Private Sub SetKey(ByVal strEncryptionKey As String)
Dim intEncryptionKeyIterator As Integer
For intEncryptionKeyIterator = 0 To 131 Step 10
If intEncryptionKeyIterator = 130 Then
astrEncryptionKey(intEncryptionKeyIterator + 0) = Mid(strEncryptionKey, 1, 2)
astrEncryptionKey(intEncryptionKeyIterator + 1) = Mid(strEncryptionKey, 3, 2)
Else
astrEncryptionKey(intEncryptionKeyIterator + 0) = Mid(strEncryptionKey, 1, 2)
astrEncryptionKey(intEncryptionKeyIterator + 1) = Mid(strEncryptionKey, 3, 2)
astrEncryptionKey(intEncryptionKeyIterator + 2) = Mid(strEncryptionKey, 5, 2)
astrEncryptionKey(intEncryptionKeyIterator + 3) = Mid(strEncryptionKey, 7, 2)
astrEncryptionKey(intEncryptionKeyIterator + 4) = Mid(strEncryptionKey, 9, 2)
astrEncryptionKey(intEncryptionKeyIterator + 5) = Mid(strEncryptionKey, 11, 2)
astrEncryptionKey(intEncryptionKeyIterator + 6) = Mid(strEncryptionKey, 13, 2)
astrEncryptionKey(intEncryptionKeyIterator + 7) = Mid(strEncryptionKey, 15, 2)
astrEncryptionKey(intEncryptionKeyIterator + 8) = Mid(strEncryptionKey, 17, 2)
astrEncryptionKey(intEncryptionKeyIterator + 9) = Mid(strEncryptionKey, 19, 2)
End If
Next
End Sub
Private Function BinaryToDouble(ByVal strData As String) As Double
Dim dblOutput As Double
Dim lngIterator As Long
Do Until Len (strData) = 0
dblOutput = dblOutput + IIf(Right$(strData, 1) = "1", (2 ^ lngIterator), 0)
strData = Left $ (strData, Len (strData) - 1)
lngIterator = lngIterator + 1
Loop
BinaryToDouble = dblOutput
End Function
Private Function DoubleToBinary(ByVal dblData As Double) As String
Dim strOutput As String
Dim lngIterator As Long
Do Until (2 ^ lngIterator)> dblData
strOutput = IIf(((2 ^ lngIterator) And dblData) > 0, "1", "0") + strOutput
lngIterator = lngIterator + 1
Loop
DoubleToBinary = strOutput
End Function
Private Function HexToString(ByVal strData As String) As String
Dim strOutput As String
Do Until Len (strData) <2
strOutput = strOutput + Chr$(CLng("&H" + Left$(strData, 2)))
strData = Right $ (strData, Len (strData) - 2)
Loop
HexToString = strOutput
End Function
Private Function StringToHex(ByVal strData As String) As String
Dim strOutput As String
Do Until Len (strData) = 0
strOutput = strOutput + Right$(String$(2, "0") + Hex$(Asc(Left$(strData, 1))), 2)
strData = Right $ (strData, Len (strData) - 1)
Loop
StringToHex = strOutput
End Function
Private Function ByteToString(ByRef bytData() As Byte, ByVal lngDataLength As Long) As String
Dim lngIterator As Long
For lngIterator = LBound(bytData) To (LBound(bytData) + lngDataLength)
ByteToString = ByteToString & CHR $ (bytData (lngIterator))
Next lngIterator
End Function
