frmrijndael.frm

Rjindeal加密算法

Dim tmpStr As String, tmpStr2 As String
Dim LineInpStr As String
Dim StrArr() As String

#If TRACE_KAT_MCT Then
    PrintF "Executing Tables KAT (key %s): ", KeyLength
#End If
    Set KeyInst = New rijndaelKeyInstance
    FPrintF FileNumber, "\n==========\n\nKEYSIZE=%s\n\n", KeyLength
    For i = 0 To 63
        FPrintF FileNumber, "\nI=%s\n", i + 1
        Line Input #FileNumber2, LineInpStr
        StrArr = Split(LineInpStr, " ")
        KeyMaterial = StrArr(0)
        KeyInst.makeKey KeyLength, Encrypt, KeyMaterial
        FPrintF FileNumber, "KEY=%s\n", KeyMaterial
        tmpStr2 = ""
        For j = 0 To 15
            tmpStr2 = tmpStr2 & StrArr(j + 1)
            If (j + 1) Mod 4 = 0 Then
                Block(j \ 4) = HexStrToLong(tmpStr2)
                tmpStr2 = ""
            End If
        Next
        FPrintF FileNumber, "PT="
        For j = 0 To 3
            FPrintF FileNumber, "%s", PadHexStr(Hex(Block(j)), 8)
        Next
        FPrintF FileNumber, "\n"
        KeyInst.CipherInit ECB
        KeyInst.blockEncrypt Block, 128, Block2
        FPrintF FileNumber, "CT="
        For j = 0 To 3
            FPrintF FileNumber, "%s", PadHexStr(Hex(Block2(j)), 8)
        Next
        FPrintF FileNumber, "\n"
    Next
    For i = 64 To 127
        FPrintF FileNumber, "\nI=%s\n", i + 1
        Line Input #FileNumber2, LineInpStr
        StrArr = Split(LineInpStr, " ")
        KeyMaterial = StrArr(0)
        KeyInst.makeKey KeyLength, Decrypt, KeyMaterial
        FPrintF FileNumber, "KEY=%s\n", KeyMaterial
        tmpStr2 = ""
        For j = 0 To 15
            tmpStr2 = tmpStr2 & StrArr(j + 1)
            If (j + 1) Mod 4 = 0 Then
                Block(j \ 4) = HexStrToLong(tmpStr2)
                tmpStr2 = ""
            End If
        Next
        KeyInst.CipherInit ECB
        KeyInst.BlockDecrypt Block, 128, Block2
        FPrintF FileNumber, "PT="
        For j = 0 To 3
            FPrintF FileNumber, "%s", PadHexStr(Hex(Block2(j)), 8)
        Next
        FPrintF FileNumber, "\n"
        FPrintF FileNumber, "CT="
        For j = 0 To 3
            FPrintF FileNumber, "%s", PadHexStr(Hex(Block(j)), 8)
        Next
        FPrintF FileNumber, "\n"
    Next
#If TRACE_KAT_MCT Then
    Debug.Print "Done"
#End If
End Sub

Private Sub MakeKats(vkFile As String, vtFile As String, tblFile As String, ivFile As String)
Dim FileNumber As Long, FileNumber2 As Long
    FileNumber = FreeFile
    Open App.Path & "\" & vkFile For Output As #FileNumber
    FPrintF FileNumber, "\n=====================\n\nFILENAME:  %s\n\nElectronic Codebook (ECB) Mode\nVariable Key Known Answer Tests\nAlgorithm Name: RijnDael", vkFile
    rijndaelVKKAT FileNumber, 128
    rijndaelVKKAT FileNumber, 192
    rijndaelVKKAT FileNumber, 256
    FPrintF FileNumber, "\n============\n"
    Close #FileNumber
    '    /* prepare Variable Text Known Answer Tests: */
    FileNumber = FreeFile
    Open App.Path & "\" & vtFile For Output As #FileNumber
    FPrintF FileNumber, "\n=================\n\nFILENAME: %s\n\nElectronic Codebook (ECB) Mode\nVariable Known Answer Tests\n\nAlgorithm Name: RijnDael\n", vtFile
    rijndaelVTKAT FileNumber, 128
    rijndaelVTKAT FileNumber, 192
    rijndaelVTKAT FileNumber, 256
    FPrintF FileNumber, "\n=============\n"
    Close #FileNumber
    '    /* prepare Tables Known Answer Tests: */
    FileNumber = FreeFile
    Open App.Path & "\" & tblFile For Output As #FileNumber
    FPrintF FileNumber, "/* Description of what tables are tested:\nThe provided implementations each use a different set of tables\n" & _
        "    - Java implementation: uses no tables\n" & _
        "    - reference C implementation: uses Logtable, Alogtable, S, Si, rcon\n" & _
        "    - fast C implementation: uses rcon and additionally\n" & _
        "        Te0, Te1, Te2, Te3, Te4, Td0, Td1, Td2, Td3, Td4.\n" & _
        "    - VB implementation: uses rcon and additionally\n" & _
        "        Te0, Te1, Te2, Te3, Te4, Td0, Td1, Td2, Td3, Td4. - as optimised C\n" & _
        "   All these tables are tested.\n" & _
        "\n" & _
        "=========================\n" & _
        "\n" & _
        "FILENAME:  %s\n" & _
        "\n" & _
        "Electronic Codebook (ECB) Mode\n" & _
        "Tables Known Answer Tests\n" & _
        "\n" & _
        "Algorithm Name: Rijndael\n\n", tblFile
    FileNumber2 = FreeFile
    Open App.Path & "\table.128.txt" For Input As #FileNumber2
    rijndaelTKAT FileNumber, 128, FileNumber2
    Close #FileNumber2
    FileNumber2 = FreeFile
    Open App.Path & "\table.192.txt" For Input As #FileNumber2
    rijndaelTKAT FileNumber, 192, FileNumber2
    Close #FileNumber2
    FileNumber2 = FreeFile
    Open App.Path & "\table.256.txt" For Input As #FileNumber2
    rijndaelTKAT FileNumber, 256, FileNumber2
    Close #FileNumber2
    FPrintF FileNumber, "\n===========\n"
    Close #FileNumber
End Sub

'#ifdef INTERMEDIATE_VALUE_KAT
'    /* prepare Intermediate Values Known Answer Tests: */
'    fp = fopen(ivFile, "w");
'    fprintf(fp,
'        "\n"
'        "=========================\n"
'        "\n"
'        "FILENAME:  \"%s\"\n"
'        "\n"
'        "Electronic Codebook (ECB) Mode\n"
'        "Intermediate Value Known Answer Tests\n"
'        "\n"
'        "Algorithm Name: Rijndael\n"
'        "Principal Submitter: %s\n",
'        ivFile, SUBMITTER);
'    fflush(fp);
'
'    rijndaelIVKAT(fp, 128);
'    rijndaelIVKAT(fp, 192);
'    rijndaelIVKAT(fp, 256);
'
'    fprintf(fp,
'        "\n"
'        "==========");
'    fclose(fp);
'#endif /* INTERMEDIATE_VALUE_KAT */
'}

Private Sub Command3_Click()
    MsgBox "None as yet"
End Sub

Private Sub DecryptFile(InputFile As String, OutputFile As String, PassWord As String)
Dim KeyInst As rijndaelKeyInstance
Dim KeyMaterial As String
Dim KeyLength As Long
Dim FileNumber As Long, FileNumber2 As Long
Dim Block(4) As Long
Dim oBlock(4) As Long
Dim CompareMaterial As String
Dim i As Long, j As Long
Dim StartTime As Long
Dim EndTime As Long
    StartTime = timeGetTime
    ' Setup key...
    KeyLength = 128
    Set KeyInst = New rijndaelKeyInstance
    KeyMaterial = KeyInst.ConvertPassWordStringToMakeKeyAcceptableFormat(PassWord, KeyLength)
    KeyInst.makeKey KeyLength, Decrypt, KeyMaterial, CBC
    ' Open files...
    FileNumber = FreeFile
    Open InputFile For Binary Access Read As #FileNumber
    
    ' Read back encryption key to check that the password
    ' was correct
    GetBlock FileNumber, Block
    KeyInst.BlockDecrypt Block, 128, oBlock
    CompareMaterial = ""
    For i = 0 To 3
        CompareMaterial = CompareMaterial & PadHexStr(Hex(oBlock(i)), 8)
    Next
    If KeyLength > 128 Then
        GetBlock FileNumber, Block
        KeyInst.BlockDecrypt Block, 128, oBlock
        If KeyLength = 192 Then
            j = 1
        Else
            j = 3
        End If
        For i = 0 To j
            CompareMaterial = CompareMaterial & PadHexStr(Hex(oBlock(i)), 8)
        Next
    End If
    If CompareMaterial <> KeyMaterial Then
        MsgBox "Invalid Password!!!"
        Close #FileNumber
        Close #FileNumber2
        Exit Sub
    End If
    On Error Resume Next
    Kill OutputFile
    On Error GoTo 0
    FileNumber2 = FreeFile
    Open OutputFile For Binary Access Write As #FileNumber2
    ' If we're ok, we just need to decrypt now
    Do While EOF(FileNumber) = False
        GetBlock FileNumber, Block
        KeyInst.BlockDecrypt Block, 128, oBlock
        PutBlock FileNumber2, oBlock
    Loop
    Close #FileNumber
    Close #FileNumber2
    EndTime = timeGetTime
    Label6.Caption = "File of size " & FileLen(InputFile) & " decrypted in " & EndTime - StartTime & " milliseconds"
End Sub

Private Sub EncryptFile(InputFile As String, OutputFile As String, PassWord As String)
Dim KeyInst As rijndaelKeyInstance
Dim KeyMaterial As String
Dim KeyLength As Long
Dim FileNumber As Long, FileNumber2 As Long
Dim Block(4) As Long
Dim oBlock(4) As Long
Dim StartTime As Long
Dim EndTime As Long
    StartTime = timeGetTime
    ' Setup key...
    KeyLength = 128
    Set KeyInst = New rijndaelKeyInstance
    KeyMaterial = KeyInst.ConvertPassWordStringToMakeKeyAcceptableFormat(PassWord, KeyLength)
    KeyInst.makeKey KeyLength, Encrypt, KeyMaterial, CBC
    
    ' Open files...
    FileNumber = FreeFile
    Open InputFile For Binary Access Read As #FileNumber
    On Error Resume Next
    Kill OutputFile
    On Error GoTo 0
    FileNumber2 = FreeFile
    Open OutputFile For Binary Access Write As #FileNumber2
    
    ' The first thing we need to do is to encrypt the key material (or some known value)
    ' This means that when we decrypt we have a check to see if
    ' decryption works OK.
    Block(0) = HexStrToLong(Mid(KeyMaterial, 1, 8))
    Block(1) = HexStrToLong(Mid(KeyMaterial, 9, 8))
    Block(2) = HexStrToLong(Mid(KeyMaterial, 17, 8))
    Block(3) = HexStrToLong(Mid(KeyMaterial, 25, 8))
    KeyInst.blockEncrypt Block, 128, oBlock
    PutBlock FileNumber2, oBlock
    If KeyLength > 128 Then
        Block(0) = 0: Block(1) = 0: Block(2) = 0: Block(3) = 0
        Block(0) = HexStrToLong(Mid(KeyMaterial, 33, 8))
        Block(1) = HexStrToLong(Mid(KeyMaterial, 41, 8))
        If KeyLength > 192 Then
            Block(2) = HexStrToLong(Mid(KeyMaterial, 49, 8))
            Block(3) = HexStrToLong(Mid(KeyMaterial, 57, 8))
        End If
        KeyInst.blockEncrypt Block, 128, oBlock
        PutBlock FileNumber2, oBlock
    End If
    ' Put "Expected number of bytes?"
    ' Now that we have output the key, I want to encrypt the file
    Do While EOF(FileNumber) = False
        GetBlock FileNumber, Block
        KeyInst.blockEncrypt Block, 128, oBlock
        PutBlock FileNumber2, oBlock
    Loop
    Close #FileNumber
    Close #FileNumber2
    EndTime = timeGetTime
    Label6.Caption = "File of size " & FileLen(InputFile) & " encrypted in " & EndTime - StartTime & " milliseconds"
End Sub

Private Sub PutBlock(FileNumber As Long, ByRef Block() As Long)
Dim i As Long
    For i = 0 To 3
        Put #FileNumber, , Block(i)
    Next
End Sub
Private Sub GetBlock(FileNumber As Long, ByRef Block() As Long)
Dim i As Long
    For i = 0 To 3
        Get #FileNumber, , Block(i)
    Next
End Sub

Private Sub Command4_Click()
Dim tmpPass As String
    tmpPass = frmPassWord.GetPassWord("Please enter password to Encrypt File", "RijnDael Block Cipher", "")
    If Len(tmpPass) = 0 Then
        Exit Sub
    End If
    EncryptFile txtRawFile.Text, txtEncryptedFile.Text, tmpPass
End Sub

Private Sub Command5_Click()
Dim tmpPass As String
    tmpPass = frmPassWord.GetPassWord("Please enter password to Decrypt File", "RijnDael Block Cipher", "")
    If Len(tmpPass) = 0 Then
        Exit Sub
    End If
    DecryptFile txtEncryptedFile.Text, txtDecrypted.Text, tmpPass
End Sub

Private Sub Command6_Click()
    On Error GoTo ErrHandler
    cdb1.CancelError = True
    cdb1.DialogTitle = "Raw File to be encrypted..."
    cdb1.Filter = "All Files (*.*)|*.*"
    cdb1.FilterIndex = 0
    cdb1.FileName = ""
    cdb1.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNLongNames Or cdlOFNPathMustExist
    cdb1.MaxFileSize = 32000
    cdb1.ShowOpen
    txtRawFile.Text = cdb1.FileName
    Exit Sub
ErrHandler:
    If Err.Number = 32755 Then
       ' cancel was selected
    Else
        MsgBox Err.Description
    End If
    Exit Sub
End Sub

Private Sub Command7_Click()
    On Error GoTo ErrHandler
    cdb1.CancelError = True
    cdb1.DefaultExt = ".rji"
    cdb1.DialogTitle = "Output file for encryption..."
    cdb1.Filter = "RijnDael encrypted files (*.rji)|*.rji"
    cdb1.FilterIndex = 0
    cdb1.FileName = ""
    cdb1.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNLongNames Or cdlOFNPathMustExist
    cdb1.MaxFileSize = 32000
    cdb1.ShowOpen
    txtEncryptedFile.Text = cdb1.FileName
    Exit Sub
ErrHandler:
    If Err.Number = 32755 Then
       ' cancel was selected
    Else
        MsgBox Err.Description
    End If
    Exit Sub
End Sub

Private Sub Command8_Click()
    On Error GoTo ErrHandler
    cdb1.CancelError = True
    cdb1.DialogTitle = "Output file for encryption..."
    cdb1.DefaultExt = ""
    cdb1.Filter = "All files (*.*)|*.*"
    cdb1.FilterIndex = 0
    cdb1.FileName = ""
    cdb1.Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNLongNames Or cdlOFNPathMustExist
    cdb1.MaxFileSize = 32000
    cdb1.ShowSave
    txtEncryptedFile.Text = cdb1.FileName
    Exit Sub
ErrHandler:
    If Err.Number = 32755 Then
       ' cancel was selected
    Else
        MsgBox Err.Description
    End If
    Exit Sub
End Sub

Private Sub Form_Load()
    txtRawFile.Text = App.Path & "\Image3.gif"
    txtEncryptedFile.Text = App.Path & "\Image3.rji"
    txtDecrypted.Text = App.Path & "\Test.gif"
End Sub