?
Solved

Block Cipher AES 256

Posted on 2014-03-08
10
Medium Priority
?
588 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
10 Comments
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 39915541
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
ID: 39915892
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 46

Expert Comment

by:aikimark
ID: 39916132
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:DemonForce
ID: 39916328
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
ID: 39916335
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
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 39916459
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)
ID: 39916483
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
ID: 39916493
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
ID: 39916500
I guess string could be converted to and from base64
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 2000 total points
ID: 39916517
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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

752 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