Option Strict Off
Option Explicit On
Imports CryptoSysAPI

Friend Class frmCryptoSys
  Inherits System.Windows.Forms.Form
  
    ' frmCryptoSys5.vb
  ' A demonstration of some of the encryption functions in the CryptoSys(tm) API.
  
  '********************* COPYRIGHT NOTICE*********************
    ' Copyright (c) 2001-16 DI Management Services Pty Limited.
  ' All rights reserved.
  ' This code is provided as a suggested interface to the CryptoSys API.
  ' Use at your own risk. Make your own tests and check that this code
  ' does what you expect. Please report any bugs to <www.di-mgt.com.au>
  ' The latest version of CryptoSys(tm) API and a licence
  ' may be obtained from <www.cryptosys.net>.
  ' This copyright notice must always be left intact.
  '************** END OF COPYRIGHT NOTICE*********************
  
  ' NOTE: Because this tries to do everything, it's more
    ' complicated than you'd need in a normal implementation.

    ' CAUTION: This is just a test-bed demo. It is not meant to be
    ' represesentative of good security code practices.
    ' There are limited error handling facilities, too.
  
  ' Invalid-length keys and IVs entered by the user are just padded with zeroes
  ' to avoid failures - don't do this in practice!
  
    ' REVISION HISTORY:
    ' Aug 2016: Upgraded [sic] from VB6 to VB.NET - complete rewrite
  ' Jan 2011: Allowed Decrypt button to work without doing Encrypt first
  ' Sep 2007: Revised for v4.0
  ' Jul 2006: Substantial revision for v3.2
  ' Jan 2006: minor update for v3.1.
  ' Feb 2005: minor update.
  ' Sep 2001: First published.
  ' ****************


    Private NL As String = System.Environment.NewLine
    Private Const HELP_URL As String = "http://www.cryptosys.net/test-bed.html"

  Private Sub cmdClose_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdClose.Click
    End
  End Sub
  
  Private Sub cmdEncrypt_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdEncrypt.Click
    ' Encrypt the plain text as required using hex strings
        Try
            Dim strPlain As String
            Dim strCipher As String
            Dim strHexKey As String
            Dim strHexIV As String
            Dim mode As Mode

            ' Get current values for key and IV
            strHexKey = SetKey()
            strHexIV = SetIV()

            ' Clear output
            Me.txtInputBlock.Text = ""
            Me.txtCipher.Text = ""
            Me.txtCipherHex.Text = ""
            Me.txtCipher64.Text = ""

            ' Convert plain text into hex if necessary
            If Me.optPTAlpha.Checked Then
                strPlain = Cnv.ToHex((Me.txtPlain).Text)
            Else
                If Not IsValidHex((Me.txtPlain).Text) Then
                    DisplayInvalidError("Invalid hex in plain text")
                    Exit Sub
                End If
                strPlain = Me.txtPlain.Text
            End If

            ' Pad input if required
            If NeedPadding() Then
                strPlain = AddPadding(strPlain)
            End If

            ' Show input data as hex
            Me.txtInputBlock.Text = strPlain

            strCipher = ""

            ' Get the current mode
            mode = GetModeEnum()

            ' Now encrypt as per algorithm
            If Me.optDES.Checked Then
                strCipher = Des.Encrypt(strPlain, strHexKey, mode, strHexIV)
            ElseIf Me.optTDEA.Checked Then
                strCipher = Tdea.Encrypt(strPlain, strHexKey, mode, strHexIV)
            ElseIf Me.optAES128.Checked Then
                strCipher = Aes128.Encrypt(strPlain, strHexKey, mode, strHexIV)
            ElseIf Me.optAES192.Checked Then
                strCipher = Aes192.Encrypt(strPlain, strHexKey, mode, strHexIV)
            ElseIf Me.optAES256.Checked Then
                strCipher = Aes256.Encrypt(strPlain, strHexKey, mode, strHexIV)
            ElseIf Me.optBLF.Checked Then
                strCipher = Blowfish.Encrypt(strPlain, strHexKey, mode, strHexIV)
            End If

            If strCipher.Length = 0 Then
                Call DisplayCryptoSysError(General.ErrorCode)
                Exit Sub
            End If

            ' Display results in hex, "raw" and base64 format
            Me.txtCipherHex.Text = strCipher
            Me.txtCipher.Text = Cnv.StringFromHex(strCipher)
            Me.txtCipher64.Text = Cnv.Base64FromHex(strCipher)
            Me.cmdDecrypt.Enabled = True

        Catch excep As System.Exception
            MessageBox.Show(excep.Message, "System Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try


    End Sub

    Private Sub cmdDecrypt_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdDecrypt.Click
        ' Decrypt the cipher text using hex strings
        Try
            Dim nBlockLen As Integer
            Dim strCipher As String
            Dim strOutputHex As String
            Dim strDecrypt As String
            Dim strHexKey As String
            Dim strHexIV As String
            Dim mode As Mode

            nBlockLen = GetBlockLen()

            ' Get current values for key and IV
            strHexKey = SetKey()
            strHexIV = SetIV()

            ' Clear output
            Me.txtDecrypt.Text = ""
            Me.txtDecryptHex.Text = ""
            Me.txtOutputBlock.Text = ""

            ' Get the current ciphertext in hex format
            strCipher = Me.txtCipherHex.Text
            If strCipher.Length = 0 Then
                DisplayInvalidError("ERROR: No ciphertext to decrypt!")
                Exit Sub
            End If

            strOutputHex = ""

            ' Get the current mode
            mode = GetModeEnum()

            ' Now decrypt as per current algorithm
            If Me.optDES.Checked Then
                strOutputHex = Des.Decrypt(strCipher, strHexKey, mode, strHexIV)
            ElseIf Me.optTDEA.Checked Then
                strOutputHex = Tdea.Decrypt(strCipher, strHexKey, mode, strHexIV)
            ElseIf Me.optAES128.Checked Then
                strOutputHex = Aes128.Decrypt(strCipher, strHexKey, mode, strHexIV)
            ElseIf Me.optAES192.Checked Then
                strOutputHex = Aes192.Decrypt(strCipher, strHexKey, mode, strHexIV)
            ElseIf Me.optAES256.Checked Then
                strOutputHex = Aes256.Decrypt(strCipher, strHexKey, mode, strHexIV)
            ElseIf Me.optBLF.Checked Then
                strOutputHex = Blowfish.Decrypt(strCipher, strHexKey, mode, strHexIV)
            End If

            If strOutputHex.Length = 0 Then
                Call DisplayCryptoSysError(General.ErrorCode)
                Exit Sub
            End If

            ' Show the unpadded output block
            Me.txtOutputBlock.Text = strOutputHex

            ' Strip padding if nec
            If NeedPadding() Then
                strDecrypt = StripPadding(strOutputHex)
                ' It is an error if no padding has been removed
                If strDecrypt.Length = strOutputHex.Length Then
                    ' CAUTION: in practice don't give clues where the decryption error happened
                    ' just say "Decryption error"
                    DisplayInvalidError("Decryption error - invalid padding bytes found")
                    Exit Sub
                End If
            Else
                strDecrypt = strOutputHex
            End If

            ' Display output in HEX and ANSI format
            Me.txtDecryptHex.Text = strDecrypt
            Me.txtDecrypt.Text = Cnv.StringFromHex(strDecrypt)

        Catch excep As System.Exception
            MessageBox.Show(excep.Message, "System Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try


    End Sub

    Private Sub cmdGenIV_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdGenIV.Click
        Call GenerateIV()
    End Sub

    Private Sub cmdGenKey_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdGenKey.Click
        ' Generate a random key silently
        Call GenerateKey(bPrompt:=False)
    End Sub

    Private Sub cmdGenKeyPrompt_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdGenKeyPrompt.Click
        ' Generate a random key with user prompt
        Call GenerateKey(bPrompt:=True)
    End Sub

    Private Sub GenerateKey(ByRef bPrompt As Boolean)
        ' Generate a random key
        Dim sHexKey As String
        Dim nBytes As Integer

        ' What length key do we need?
        If Me.optDES.Checked Then
            nBytes = 8
        ElseIf Me.optTDEA.Checked Then
            nBytes = 24
        ElseIf Me.optAES128.Checked Then
            nBytes = 16
        ElseIf Me.optAES192.Checked Then
            nBytes = 24
        ElseIf Me.optAES256.Checked Then
            nBytes = 32
        Else
            ' Set to 16 byte length by default
            nBytes = 16
        End If

        If bPrompt Then
            sHexKey = Rng.HexWithPrompt(nBytes)
        Else
            sHexKey = Rng.KeyHex(nBytes, "")
        End If

        Me.optHexKey.Checked = True
        Me.txtKey.Text = sHexKey
        Me.txtKeyAsString.Text = sHexKey
        ' Allow encrypt and decrypt buttons
        Me.cmdEncrypt.Enabled = True
        Me.cmdDecrypt.Enabled = True
        ' Put user in plaintext box
        Me.txtPlain.Focus()

    End Sub

    Private Sub GenerateIV()
        ' Generate a random key
        Dim sHexIV As String
        Dim nBytes As Integer

        ' What length IV do we need?
        nBytes = GetBlockLen()

        sHexIV = Rng.NonceHex(nBytes)

        Me.txtIV.Text = sHexIV
        Me.txtIVAsString.Text = sHexIV

    End Sub

    Private Sub cmdSetKey_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdSetKey.Click
        Call SetKey()
        Call SetIV()
    End Sub

    Private Function SetKey() As String
        ' Set key as a hex string
        Dim nKeyLen As Integer
        Dim nPad As Integer
        Dim strKey As String

        SetKey = ""
        ' What format is the key in?
        If Me.optHexKey.Checked Then
            If IsValidHex((Me.txtKey).Text) Then
                strKey = Me.txtKey.Text
            Else
                DisplayInvalidError("Key is not valid hex")
                Me.txtKey.Focus()
                Exit Function
            End If
        Else
            ' User has provided a plain alpha string
            strKey = Cnv.ToHex((Me.txtKey).Text)
        End If

        ' Now pad key with zeroes as per algorithm's key size
        If Me.optDES.Checked Then
            nKeyLen = 8
        ElseIf Me.optTDEA.Checked Then
            nKeyLen = 24
        ElseIf Me.optAES128.Checked Then
            nKeyLen = 16
        ElseIf Me.optAES192.Checked Then
            nKeyLen = 24
        ElseIf Me.optAES256.Checked Then
            nKeyLen = 32
        Else
            nKeyLen = strKey.Length \ 2
        End If

        ' Catch zero key length - default to 16 bytes
        If nKeyLen = 0 Then nKeyLen = 16

        ' nKeyLen is # of bytes - we want len of hex string
        nPad = nKeyLen * 2 - strKey.Length
        If nPad > 0 Then
            strKey = strKey & New String("0", nPad)
        ElseIf nPad < 0 Then
            strKey = strKey.Substring(0, nKeyLen * 2)
        End If

        ' Show key
        Me.txtKeyAsString.Text = strKey
        ' Allow encrypt (and decrypt)
        Me.cmdEncrypt.Enabled = True
        Me.cmdDecrypt.Enabled = True
        ' Put user in plaintext box
        Me.txtPlain.Focus()

        SetKey = strKey


    End Function

    Private Function SetIV() As String
        ' Set IV and show value in current IV box
        Dim strHexIV As String

        SetIV = ""
        ' Do we need an IV? If not, clear current value
        If Not NeedIV() Then
            strHexIV = ""
            Me.txtIVAsString.Text = strHexIV
            Exit Function
        Else
            strHexIV = Me.txtIV.Text
        End If

        ' Now pad IV with zeroes to match algorithm block length
        strHexIV = FixHexLength(strHexIV, GetBlockLen())

        ' Show IV
        Me.txtIVAsString.Text = strHexIV

        SetIV = strHexIV

    End Function

    Private Function FixHexLength(ByRef strInputHex As String, ByRef nBytes As Integer) As String
        ' Given a hex string, either pad with zeroes to make up to nBytes long or truncate.
        Dim nPad As Integer

        nPad = nBytes * 2 - strInputHex.Length
        If nPad > 0 Then
            FixHexLength = strInputHex & New String("0", nPad)
        ElseIf nPad < 0 Then
            FixHexLength = strInputHex.Substring(0, nBytes * 2)
        Else
            FixHexLength = strInputHex
        End If

    End Function

    Private Function GetModeStr() As String
        ' Return the required string for the current mode
        GetModeStr = GetModeEnum().ToString
    End Function

    Private Function GetModeEnum() As Mode
        ' Return the required enum for the selected mode
        If Me.optModeCBC.Checked Then
            GetModeEnum = Mode.CBC
        ElseIf Me.optModeCTR.Checked Then
            GetModeEnum = Mode.CTR
        ElseIf Me.optModeCFB.Checked Then
            GetModeEnum = Mode.CFB
        ElseIf Me.optModeOFB.Checked Then
            GetModeEnum = Mode.OFB
        Else ' Default
            GetModeEnum = Mode.ECB
        End If
    End Function

    Private Function NeedIV() As Boolean
        ' All modes except ECB require an IV
        NeedIV = (GetModeStr() <> "ECB")
    End Function

    Private Function NeedPadding() As Boolean
        ' We need padding if the user has asked for it AND we are in ECB or CBC mode
        Dim sMode As String
        sMode = GetModeStr()
        NeedPadding = (Me.optNoPad.Checked = False) And (sMode = "ECB" Or sMode = "CBC")
    End Function

    Private Function GetPaddingEnum() As CryptoSysAPI.Padding
        Dim padding As CryptoSysAPI.Padding
        If Me.optPad.Checked Then
            padding = CryptoSysAPI.Padding.Pkcs5
        ElseIf Me.optPad1Zero.Checked Then
            padding = CryptoSysAPI.Padding.OneAndZeroes
        ElseIf Me.optPadX923.Checked Then
            padding = CryptoSysAPI.Padding.AnsiX923
        ElseIf Me.optPadW3C.Checked Then
            padding = CryptoSysAPI.Padding.W3CPadding
            ' These should not happen!...
        ElseIf Me.optNoPad.Checked Then
            padding = CryptoSysAPI.Padding.NoPad
        Else
            padding = CryptoSysAPI.Padding.Default
        End If
        Return padding
    End Function

    Private Function AddPadding(ByVal strPlain As String) As String
        Dim padding As CryptoSysAPI.Padding

        padding = GetPaddingEnum()

        ' We use the generic Cipher.Pad() method here, 
        ' which allows us to specify the type of padding
        ' but does not support Des or Blowfish. 
        ' However, note that these both have
        ' an 8-byte blocksize so we just use the Tdea version instead.
        If Me.optAES128.Checked Then
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Aes128, padding)
        ElseIf Me.optAES192.Checked Then
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Aes192, padding)
        ElseIf Me.optAES256.Checked Then
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Aes256, padding)
        ElseIf Me.optTDEA.Checked Then
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Tdea, padding)
        ElseIf Me.optDES.Checked Then  ' (same as Tdea)
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Tdea, padding)
        ElseIf Me.optBLF.Checked Then  ' (same as Tdea)
            strPlain = Cipher.Pad(strPlain, CipherAlgorithm.Tdea, padding)
        End If

        Return strPlain

    End Function

    Private Function StripPadding(ByVal strToStrip As String) As String
        Dim strDecrypt As String
        Dim padding As CryptoSysAPI.Padding

        padding = GetPaddingEnum()
        strDecrypt = strToStrip

        If Me.optAES128.Checked Then
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Aes128, Padding)
        ElseIf Me.optAES192.Checked Then
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Aes192, Padding)
        ElseIf Me.optAES256.Checked Then
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Aes256, Padding)
        ElseIf Me.optTDEA.Checked Then
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Tdea, Padding)
        ElseIf Me.optDES.Checked Then  ' (same as Tdea)
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Tdea, Padding)
        ElseIf Me.optBLF.Checked Then  ' (same as Tdea)
            strDecrypt = Cipher.Unpad(strToStrip, CipherAlgorithm.Tdea, Padding)
        End If


        Return strDecrypt

    End Function

    Private Function GetBlockLen() As Integer
        ' Return length in bytes of current algorithm's block size
        If Me.optDES.Checked Then
            GetBlockLen = Des.BlockSize
        ElseIf Me.optTDEA.Checked Then
            GetBlockLen = Tdea.BlockSize
        ElseIf Me.optBLF.Checked Then
            GetBlockLen = Blowfish.BlockSize
        ElseIf Me.optAES128.Checked Then
            GetBlockLen = Aes128.BlockSize
        ElseIf Me.optAES192.Checked Then
            GetBlockLen = Aes192.BlockSize
        ElseIf Me.optAES256.Checked Then
            GetBlockLen = Aes256.BlockSize
        Else ' default
            GetBlockLen = 8
        End If
    End Function

    Private Function IsValidHex(ByRef strToCheck As String) As Boolean
        ' Returns True if strToCheck only contains valid hexadecimal digits
        Const scHEXDIGITS As String = "0123456789ABCDEFabcdef"
        ' NB Include both uc and lc just in case Binary Compare mode

        IsValidHex = True
        For Each c As Char In strToCheck
            If scHEXDIGITS.IndexOf(c) < 0 Then
                IsValidHex = False
                Exit For
            End If
        Next
    End Function

    Private Sub DisplayInvalidError(strMessage As String)
        MessageBox.Show(strMessage, "Invalid data", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
    End Sub

    Private Sub DisplayCryptoSysError(ByRef nRet As Integer)
        MessageBox.Show("CryptoSys error " & nRet & " has occurred: " & _
            NL & NL & General.ErrorLookup(nRet), "CryptoSys Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Sub

 
    Private Sub cmdHelp_Click(sender As Object, e As EventArgs) Handles cmdHelp.Click
        Try
            Cursor.Current = Cursors.WaitCursor
            Process.Start(HELP_URL)
        Catch excep As System.Exception
            MessageBox.Show(excep.Message, "System Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            Cursor.Current = Cursors.Default
        End Try
    End Sub

    Private Sub frmCryptoSys_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.lblVersion.Text = "Core DLL Version: " & General.Version() & _
            " (" & General.Platform & ")" & _
            " [" & General.CompileTime() & "]"
    End Sub
End Class