Solved

Block Cipher AES 256

Posted on 2014-03-08
10
532 Views
Last Modified: 2014-06-23
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 :(
0
Comment
Question by:DemonForce
  • 5
  • 4
10 Comments
 
LVL 32

Expert Comment

by:Robberbaron (robr)
Comment Utility
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.
0
 

Author Comment

by:DemonForce
Comment Utility
Cheers for that, not seen that one yet.  Although its a class and importable into Excel I have no idea how to call it?
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
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
0
 

Author Comment

by:DemonForce
Comment Utility
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
0
 

Author Comment

by:DemonForce
Comment Utility
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
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 32

Expert Comment

by:Robberbaron (robr)
Comment Utility
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

0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
Comment Utility
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

0
 

Author Comment

by:DemonForce
Comment Utility
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
0
 

Author Comment

by:DemonForce
Comment Utility
I guess string could be converted to and from base64
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
Comment Utility
My test2 worked fine. It was when i tried to save d the encrypted result as string rather than byte array that the error occured,

So saving as Base64 or saved as a hex representation may be best.

see Byte2Hex and Hex2Byte here... http://www.vbforums.com/showthread.php?559398-Byte-array-to-hex-string
the result is a string that is hex representation of Byte array that can then be converted back.

this works for me
    Dim myTest3 As String, myKey3 As String, myCoded As String
    myTest3 = "the Quick Brown Fox": myKey3 = "Jumped123"
    Debug.Print "-----3------"
    Debug.Print "Message3=" & myTest3 & "<BR>"
    Debug.Print "Key=" & myKey3 & "<BR>"
    myCoded = EncryptAES(myTest3, myKey3)
    
    Debug.Print "test3=" & DecryptAES(myCoded, myKey3) & "<BR>"

Open in new window

Option Explicit
Public Function EncryptAES(myText As String, myKey As String) As String
    Dim cr As CRijndael
    Set cr = New CRijndael
    cr.gentables '    gentables

    ReDim bytePlain(1) As Byte, bytePassword(1) As Byte, bytex(1) As Byte, bytClear(1) As Byte
    bytePlain = String2Byte(myText)
    bytePassword = String2Byte(myKey)
    
    bytex = cr.EncryptData(bytePlain(), bytePassword())
    EncryptAES = ByteArrayToHexStr(bytex)
    
    Set cr = Nothing
    
End Function

Public Function DecryptAES(cipherText As String, myKey As String) As String
    Dim cr As CRijndael
    Set cr = New CRijndael
    cr.gentables '    gentables

    ReDim bytePassword(1) As Byte, bytex(1) As Byte, bytClear(1) As Byte
    bytex = HexStrToByteArray(cipherText)
    bytePassword = String2Byte(myKey)
    
    bytClear = cr.DecryptData(bytex(), bytePassword())
    DecryptAES = Byte2String(bytClear)
    
    Set cr = Nothing

End Function

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
''http://www.vbforums.com/showthread.php?559398-Byte-array-to-hex-string
Function ByteArrayToHexStr(b() As Byte) As String
   Dim n As Long, i As Long
   
   ByteArrayToHexStr = Space$(3 * (UBound(b) - LBound(b)) + 2)
   n = 1
   For i = LBound(b) To UBound(b)
      Mid$(ByteArrayToHexStr, n, 2) = Right$("00" & Hex$(b(i)), 2)
      n = n + 3
   Next
End Function

Function HexStrToByteArray(HexStr As String) As Variant
   
   Dim n As Long, i As Long
   On Error GoTo EH
   ReDim byArray(0 To (Len(HexStr) + 1) \ 3 - 1) As Byte
   n = 0
   For i = 1 To Len(HexStr) Step 3
        byArray(n) = CByte("&H" & Mid$(HexStr, i, 2))
        n = n + 1
   Next
EH:
   If Err Then
        HexStrToByteArray = Null
        Err.Clear
   Else
        HexStrToByteArray = byArray
   End If
End Function

Open in new window

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now