rijndael.frm

Good security provider by using biometric feature as key. This is the program of server.

VERSION 5.00
Begin VB.Form fRijndael 
   Caption         =   "Server"
   ClientHeight    =   1740
   ClientLeft      =   9195
   ClientTop       =   1215
   ClientWidth     =   5820
   LinkTopic       =   "Form1"
   ScaleHeight     =   1740
   ScaleWidth      =   5820
   Begin VB.TextBox txtfilenametosend 
      Height          =   375
      Left            =   1200
      TabIndex        =   9
      Top             =   2160
      Visible         =   0   'False
      Width           =   5175
   End
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   720
      MultiLine       =   -1  'True
      TabIndex        =   8
      Top             =   3600
      Visible         =   0   'False
      Width           =   2415
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "&Send encrypted AES key"
      Height          =   495
      Left            =   2640
      TabIndex        =   7
      Top             =   1080
      Width           =   1575
   End
   Begin VB.CommandButton cmdFileEncrypt 
      BackColor       =   &H8000000D&
      Caption         =   "&Encrypt File"
      Enabled         =   0   'False
      Height          =   495
      Left            =   4560
      TabIndex        =   6
      Top             =   1080
      Width           =   1095
   End
   Begin VB.ComboBox cboKeySize 
      Height          =   315
      Left            =   1800
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   3120
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.ComboBox cboBlockSize 
      Height          =   315
      Left            =   1800
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   2760
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.TextBox txtPassword 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   2160
      MaxLength       =   16
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   600
      Width           =   3495
   End
   Begin VB.Label Label3 
      Caption         =   "Key Size:"
      Height          =   255
      Left            =   360
      TabIndex        =   5
      Top             =   3120
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "Block Size:"
      Height          =   255
      Left            =   360
      TabIndex        =   4
      Top             =   2760
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "AES Key (16 Bytes)"
      Height          =   195
      Left            =   240
      TabIndex        =   3
      Top             =   600
      Width           =   1380
   End
End
Attribute VB_Name = "fRijndael"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_Rijndael As New cRijndael
'Used to display what the program is doing in the Form's caption
Public Property Let Status(TheStatus As String)
    If Len(TheStatus) = 0 Then
        Me.Caption = App.Title
    Else
        Me.Caption = App.Title & " - " & TheStatus
    End If
    Me.Refresh
End Property
'Reverse of HexDisplay.  Given a String containing Hex values, convert to byte array data()
'Returns number of bytes n in data(0 ... n-1)
Private Function HexDisplayRev(TheString As String, data() As Byte) As Long
    Dim i As Long
    Dim j As Long
    Dim c As Long
    Dim d As Long
    Dim n As Long
    Dim data2() As Byte

    n = 2 * Len(TheString)
    data2 = TheString

    ReDim data(n \ 4 - 1)

    d = 0
    i = 0
    j = 0
    Do While j < n
        c = data2(j)
        Select Case c
        Case 48 To 57    '"0" ... "9"
            If d = 0 Then   'high
                d = c
            Else            'low
                data(i) = (c - 48) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        Case 65 To 70   '"A" ... "F"
            If d = 0 Then   'high
                d = c - 7
            Else            'low
                data(i) = (c - 55) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        Case 97 To 102  '"a" ... "f"
            If d = 0 Then   'high
                d = c - 39
            Else            'low
                data(i) = (c - 87) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        End Select
        j = j + 2
    Loop
    n = i
    If n = 0 Then
        Erase data
    Else
        ReDim Preserve data(n - 1)
    End If
    HexDisplayRev = n

End Function

'Returns a byte array containing the password in the txtPassword TextBox control.
'If "Plaintext is hex" is checked, and the TextBox contains a Hex value the correct
'length for the current KeySize, the Hex value is used.  Otherwise, ASCII values
'of the txtPassword characters are used.
Private Function GetPassword() As Byte()
    Dim data() As Byte

        If HexDisplayRev(txtPassword.Text, data) <> (cboKeySize.ItemData(cboKeySize.NewIndex) \ 8) Then
            data = StrConv(txtPassword.Text, vbFromUnicode)
            ReDim Preserve data(31)
        End If
    
    GetPassword = data
End Function

Private Sub cmdFileEncrypt_Click()
    Dim FileName  As String
    Dim FileName1 As String
    Dim FileName2 As String
    Dim FileName3 As String
    Dim FName_Only As String
    Dim delay As Long
    Dim strtext1 As String
    Dim strtext2 As String
    Dim fn, fn1 As Integer
    Dim pass()    As Byte
    Dim KeyBits  As Long
    Dim BlockBits As Long
    Dim AESFile As String
    Dim fnum As String

    fnum = frmServer.txtfilenumber.Text
    
    Select Case (Val(fnum))
    Case 1
        FileName = "D:\files\1baby.bmp"
    Case 2
        FileName = "D:\files\2baby.gif"
    Case 3
        FileName = "D:\files\3Sunset.jpg"
    Case 4
        FileName = "D:\files\4Aathichudi.3gp"
    Case 5
        FileName = "D:\files\5Yuvaraj-6History.wmv"
    Case 6
        FileName = "D:\files\6hai.txt"
    Case 7
        FileName = "D:\files\7fts.ppt"
    Case 8
        FileName = "D:\files\8Mobile Phone Secrets.doc"
    Case 9
        FileName = "D:\files\9mobile.pdf"
    Case 10
        FileName = "D:\files\10wrar360.exe"
    End Select
    
    txtPassword = frmServer.txtPassword
    
    If Len(txtPassword.Text) = 0 Then
        MsgBox "No Password"
    Else
        If Len(FileName) <> 0 Then

            FileName1 = FileName & ".aes"

            If Len(FileName1) <> 0 Then
       
                RidFile FileName1
                KeyBits = cboKeySize.ItemData(cboKeySize.NewIndex)
                BlockBits = cboBlockSize.ItemData(cboBlockSize.NewIndex)
                pass = GetPassword

                Status = "Encrypting File"
                
                m_Rijndael.SetCipherKey pass, KeyBits
                m_Rijndael.FileEncrypt FileName, FileName1
               
               fn = FreeFile

               Open FileName1 For Binary Access Read As fn
                    strtext1 = Input$(LOF(fn), fn)
                Close fn

               strtext2 = strtext1 & "Biokey" & Text3
               
               fn1 = FreeFile
               Open "c:\files\AESappending.txt.aes" For Binary Access Write As fn1
                    Put #fn1, , strtext2
               Close fn1
                              
                FileName3 = "c:\files\AESappending.txt.aes"
                FileName2 = FileName & ".aes.aes"
                RidFile FileName2
                KeyBits = cboKeySize.ItemData(cboKeySize.NewIndex)
                BlockBits = cboBlockSize.ItemData(cboBlockSize.NewIndex)
                pass = GetPassword

               Status = "Encrypting File"
                
               m_Rijndael.SetCipherKey pass, KeyBits
               m_Rijndael.FileEncrypt FileName3, FileName2
          
               frmServeraes.Slider1 = 4
               frmServeraes.txtFileName = FileName2
                Status = ""
            End If
        End If
    End If
    
    FileName2 = FileDialog(Me, False, "File to Encrypt", "*.aes.aes|*.aes.aes")
    txtfilenametosend = FileName2
    
    If txtfilenametosend = "" Then
       MsgBox "No file selected to send...", vbCritical
    Else ' send the file, if connected
       If frmWSK.tcpServer.State <> sckClosed Then
          ' send only the file name because it will
          ' be stored in another area than the source
          FName_Only$ = GetFileName(txtfilenametosend)
    For delay = 0 To 100000
    Next delay
          SendFile1 FName_Only$
       End If
    End If

End Sub

Private Sub cmdSend_Click()
frmServer.Send_Click
End Sub

Private Sub Form_Initialize()
    cboBlockSize.AddItem "128 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 128
    cboBlockSize.Enabled = False
    
    cboKeySize.AddItem "128 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 128
    cboKeySize.Enabled = False

    txtPassword = frmServer.txtPassword
    Status = ""
End Sub

Private Sub Form_Load()
Load frmServeraes
End Sub