asked on

Block Cipher AES 256

Hi,

I am using an external xml file which I read in, this xml file contains a field called certificate, this value holds a cryptorc4 code in HEX which once decrypted shows the username for the certificate, this is ok however its a stream cipher so changing a single value changes the license. I have used it with SHA256 to authenticate the code, but not really keen on this method.

I would prefer to use AES256 encryption/dec for my certificate as it is also a block cipher, does anyone please have some simple running code which will enc/dec to aes256 please.
I would prefer not to use dll etc if possible as I would need to distribute this.

Thank you.

p.s. I have tried modifying various codes around the net to no avail :(

Robberbaron (robr)

tried this one ? http://www.freevbcode.com/ShowCode.asp?ID=2389

has VBS & VB6 so should be easy enough to convert to VBA. AES256 is subset of rundel apparently.

DemonForce

ASKER

Cheers for that, not seen that one yet. Although its a class and importable into Excel I have no idea how to call it?

aikimark

The system.security.cryptography namespace(s) in the .Net framework have a COM wrapper. I've used them answering a hashing question:
http:Q_27847973.html#a38358931

DemonForce

ASKER

Hi,

using this to encrypt which works well..

Public Function encrypt(text As String, key As String) As String
Application.Volatile

Dim oTest As CRijndael
Dim sTemp As String
Dim bytIn() As Byte
Dim bytOut() As Byte
Dim bytPassword() As Byte
Dim bytClear() As Byte
Dim lCount As Long
Dim lLength As Long

Set oTest = New CRijndael

bytIn = text
bytPassword = key

sTemp = text
lLength = Len(sTemp)
ReDim bytIn(lLength - 1)
For lCount = 1 To lLength
bytIn(lCount - 1) = AscB(Mid(sTemp, lCount, 1))
Next
sTemp = key
lLength = Len(sTemp)
ReDim bytPassword(lLength - 1)
For lCount = 1 To lLength
bytPassword(lCount - 1) = AscB(Mid(sTemp, lCount, 1))
Next

bytOut = oTest.EncryptData(bytIn, bytPassword)
lLength = UBound(bytOut) + 1
sTemp = String(lLength, " ")
For lCount = 1 To lLength
Mid(sTemp, lCount, 1) = Chr(bytOut(lCount - 1))
Next

encrypt = sTemp
End Function

and this to decrypt, not working :(

Public Function decrypt(text As String, key As String) As String
Application.Volatile

Dim oTest As CRijndael
Dim sTemp As String
Dim bytIn() As Byte
Dim bytOut() As Byte
Dim bytPassword() As Byte
Dim bytClear() As Byte
Dim lCount As Long
Dim lLength As Long

Set oTest = New CRijndael

bytIn = text
bytPassword = key

sTemp = bytIn
lLength = Len(sTemp)
ReDim bytOut(lLength - 1)
For lCount = 1 To lLength
bytOut(lCount - 1) = AscB(Mid(sTemp, lCount, 1))
Next
bytClear = oTest.DecryptData(bytOut, bytPassword)

lLength = UBound(bytClear) + 1
sTemp = String(lLength, " ")
For lCount = 1 To lLength
Mid(sTemp, lCount, 1) = Chr(bytClear(lCount - 1))
Next

decrypt = sTemp
End Function

DemonForce

ASKER

Took the class from http://www.freevbcode.com/ShowCode.asp?ID=2389 and loaded into excel, modified code for encrypt slightly so its compatible with excel vba,

If I do not use the optional method and just use the straight to HEX it works both ways, but trying to get it to encode/decode using the optional method in example and it fails to decrypt

Robberbaron (robr)

I loaded the CRinjndel class directly into VBA without issue.
my test code modified from his.. along with creating functions for conversions to & from byte array...

i dim'd all the options as byte arrays. in your test, you cast the string into bytearray bytIn = text which may be the problem.

Option Explicit
Sub Test2()
    Dim sTemp As String
    Dim sPlain As String
    Dim sPassword As String
    Dim bytIn() As Byte
    Dim bytPassword() As Byte
    Dim bytOut() As Byte
        
    Dim lCount As Long
    
    Dim cr As CRijndael
    
    
    Set cr = New CRijndael
    cr.gentables '    gentables
    sPlain = "Plain text2"
    sPassword = "Key2"

    Debug.Print "Message=" & sPlain & "<BR>"
    Debug.Print "Key=" & sPassword & "<BR>"

    ReDim bytePlain(1) As Byte, bytePassword(1) As Byte, byteout(1) As Byte, bytClear(1) As Byte
    bytePlain = String2Byte(sPlain)
    bytePassword = String2Byte(sPassword)

    
    byteout = cr.EncryptData(bytePlain(), bytePassword())
    
    Debug.Print "Encrypted=" & Byte2Hex(byteout)
    
    bytClear = cr.DecryptData(byteout(), bytePassword())

    Debug.Print "Decrypted=" & Byte2String(bytClear()) & "<BR>"

    Debug.Print "<BR>"

    
End Sub

Function String2Byte(textin As String) As Variant
    Dim lLength As Long, lCount As Integer
    lLength = Len(textin)
    ReDim byteout(lLength - 1) As Byte
    For lCount = 1 To lLength
        byteout(lCount - 1) = CByte(AscB(Mid(textin, lCount, 1)))
    Next
    String2Byte = byteout()
End Function

Function Byte2String(byteIn() As Byte) As String
    Dim sTemp As String, lCount As Long, lLength As Long
    lLength = UBound(byteIn) + 1
    For lCount = 0 To lLength - 1
        sTemp = sTemp & Chr(byteIn(lCount))
    Next
    Byte2String = sTemp
End Function

Function Byte2Hex(byteIn() As Byte) As String
    Dim sTemp As String, lCount As Long
    For lCount = 0 To UBound(byteIn)
        sTemp = sTemp & Right("0" & Hex(byteIn(lCount)), 2)
    Next
    Byte2Hex = sTemp
End Function

Open in new window

Robberbaron (robr)

also the encrypted data cant really be stored as text as it could have nulls ?

i tried using a function similar to yours and it throws an error on decrypt. if you need to store encrypted result as a string then some form of escaping characters is likely required.

Option Explicit
Sub Test2()
    Dim sTemp As String
    Dim sPlain As String
    Dim sPassword As String
    Dim bytIn() As Byte
    Dim bytPassword() As Byte
    Dim bytOut() As Byte
        
    Dim lCount As Long
    
    Dim cr As CRijndael
    
    
    Set cr = New CRijndael
    cr.gentables '    gentables
    sPlain = "Plain text2"
    sPassword = "Key2"

    Debug.Print "Message=" & sPlain & "<BR>"
    Debug.Print "Key=" & sPassword & "<BR>"

    ReDim bytePlain(1) As Byte, bytePassword(1) As Byte, byteout(1) As Byte, bytClear(1) As Byte
    bytePlain = String2Byte(sPlain)
    bytePassword = String2Byte(sPassword)

    
    byteout = cr.EncryptData(bytePlain(), bytePassword())
    
    Debug.Print "Encrypted=" & Byte2Hex(byteout)
    
    bytClear = cr.DecryptData(byteout(), bytePassword())

    Debug.Print "Decrypted=" & Byte2String(bytClear()) & "<BR>"

    Debug.Print "<BR>"

    
End Sub

Function String2Byte(textin As String) As Variant
    Dim lLength As Long, lCount As Integer
    lLength = Len(textin)
    ReDim byteout(lLength - 1) As Byte
    For lCount = 1 To lLength
        byteout(lCount - 1) = CByte(AscB(Mid(textin, lCount, 1)))
    Next
    String2Byte = byteout()
End Function

Function Byte2String(byteIn() As Byte) As String
    Dim sTemp As String, lCount As Long, lLength As Long
    lLength = UBound(byteIn) + 1
    For lCount = 0 To lLength - 1
        sTemp = sTemp & Chr(byteIn(lCount))
    Next
    Byte2String = sTemp
End Function

Function Byte2Hex(byteIn() As Byte) As String
    Dim sTemp As String, lCount As Long
    For lCount = 0 To UBound(byteIn)
        sTemp = sTemp & Right("0" & Hex(byteIn(lCount)), 2)
    Next
    Byte2Hex = sTemp
End Function

Open in new window

DemonForce

ASKER

Thats great, but I can not seem to make it a workable function, so I use encrypt (a1) and then decrypt (result) to get original, I can get the encrypt to work, but decrypt fails again

DemonForce

ASKER

I guess string could be converted to and from base64

ASKER CERTIFIED SOLUTION

Robberbaron (robr)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial