home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmManager BorderStyle = 1 'Fixed Single Caption = "Encrypt / Decrypt manager" ClientHeight = 4380 ClientLeft = 150 ClientTop = 720 ClientWidth = 8280 LinkTopic = "Form1" MaxButton = 0 'False OLEDropMode = 1 'Manual ScaleHeight = 4380 ScaleWidth = 8280 StartUpPosition = 3 'Windows Default Begin VB.TextBox txtPassPhrase Height = 285 IMEMode = 3 'DISABLE Left = 1425 OLEDropMode = 1 'Manual TabIndex = 0 Top = 300 Width = 6390 End Begin VB.Frame Frame1 Height = 90 Left = -225 TabIndex = 12 Top = 0 Width = 9090 End Begin VB.CommandButton cmdDecrypt Caption = "Decrypt" Height = 375 Left = 6900 TabIndex = 6 Top = 1575 Width = 1290 End Begin VB.CommandButton cmdSelectSourceFile Caption = "..." Height = 285 Left = 7875 TabIndex = 2 Top = 675 Width = 285 End Begin VB.CommandButton cmdEncrypt Caption = "Encrypt" Height = 375 Left = 5550 TabIndex = 5 Top = 1575 Width = 1290 End Begin VB.TextBox txtSourceFile Height = 285 Left = 1425 OLEDropMode = 1 'Manual TabIndex = 1 Top = 675 Width = 6390 End Begin VB.TextBox txtDestinationFile Height = 285 Left = 1425 OLEDropMode = 2 'Automatic TabIndex = 3 Top = 1050 Width = 6390 End Begin VB.CommandButton cmdSelectDestinationFile Caption = "..." Height = 285 Left = 7875 TabIndex = 4 Top = 1050 Width = 285 End Begin MSComDlg.CommonDialog dlgCommon Left = 75 Top = 1425 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Frame Frame3 Height = 90 Left = -75 TabIndex = 9 Top = 2175 Width = 8415 End Begin VB.TextBox txtMessage Height = 1665 Left = 75 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 7 Top = 2625 Width = 8115 End Begin VB.Label lbl Caption = "Pass phrase" Height = 240 Index = 0 Left = 75 TabIndex = 13 Top = 300 Width = 915 End Begin VB.Label lbl Caption = "Source file" Height = 240 Index = 2 Left = 75 TabIndex = 11 Top = 675 Width = 915 End Begin VB.Label lbl Caption = "Destination file" Height = 240 Index = 3 Left = 75 TabIndex = 10 Top = 1050 Width = 1215 End Begin VB.Label lbl Caption = "Error / Warning message" Height = 240 Index = 4 Left = 75 TabIndex = 8 Top = 2400 Width = 2565 End Begin VB.Menu mnuFile Caption = "File" Begin VB.Menu mnuQuit Caption = "Quit" End End Begin VB.Menu mnuOption Caption = "Options" End Attribute VB_Name = "frmManager" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' Xceed Encryption Library - Encryption Manager sample ' Copyright (c) 2001 Xceed Software Inc. ' [Manager.frm] ' This form module contains the main form's code. It demonstrates how to ' encrypt a file using different kinds of encryption methods, and decrypt an ' encryted file. It specifically uses: ' - The ProcessFile, SetSecretKeyFromPassPhrase and SetRandomInitVector method. ' - The EncryptionMode, PaddingMethod, HashingMethod properties. ' This file is part of the Xceed Encryption Library sample applications. ' The source code in this file is only intended as a supplement to Xceed ' Encryption Library's documentation, and is provided "as is", without ' warranty of any kind, either expressed or implied. Option Explicit 'The different encryption methods Public Enum enuEncryptionMethod eemRijndael = 0 eemTwoFish = 1 End Enum 'The different hashing methods Public Enum enuHashingMethod ehmSHA = 0 ehmHaval = 1 End Enum 'The values chosen by the user in the Option form Private m_eEncryptionMethod As enuEncryptionMethod Private m_eEncryptionMode As EXEEncryptionMode Private m_ePaddingMethod As EXEPaddingMethod Private m_eHashingMethod As enuHashingMethod Private m_lKeySize As Integer '==================================================================================== ' EVENTS - triggered by the form and its controls '==================================================================================== '------------------------------------------------------------------------------------ 'Select the destination folder and file name that will be process when encrypting or 'decrypting '------------------------------------------------------------------------------------ Private Sub cmdSelectDestinationFile_Click() With dlgCommon .FileName = "" .DialogTitle = "Destination file" .Filter = "Encrypted (*.aes;*.2fs)|*.aes;*.2fs|All type (*.*)|*.*" .FilterIndex = 0 .Flags = cdlOFNExplorer On Error Resume Next Call .ShowSave If Err.Number = 0 Then txtDestinationFile.Text = .FileName End If On Error GoTo 0 End With End Sub '------------------------------------------------------------------------------------ 'Select the source folder and file name that will be process when encrypting or 'decrypting '------------------------------------------------------------------------------------ Private Sub cmdSelectSourceFile_Click() With dlgCommon .FileName = "" .DialogTitle = "Source file" .Filter = "All type (*.*)|*.*" .FilterIndex = 0 .Flags = cdlOFNExplorer On Error Resume Next Call .ShowOpen If Err.Number = 0 Then txtSourceFile.Text = .FileName Call SetDestinationFileName End If On Error GoTo 0 End With End Sub '------------------------------------------------------------------------------------ 'Encrypt the selected source file to the specified destination file '------------------------------------------------------------------------------------ Private Sub cmdEncrypt_Click() If EncryptFile(txtSourceFile.Text, txtDestinationFile.Text) Then 'If the encryption is successful, empty the source and destination 'text box to simplify subsequent encryption/decryption. txtSourceFile.Text = "" txtDestinationFile.Text = "" End If End Sub '------------------------------------------------------------------------------------ 'Decrypt the selected source file to the specified destination file '------------------------------------------------------------------------------------ Private Sub cmdDecrypt_Click() If DecryptFile(txtSourceFile.Text, txtDestinationFile.Text) Then 'If the decryption is successful, empty the source and destination 'text box to simplify subsequent encryption/decryption. txtSourceFile.Text = "" txtDestinationFile.Text = "" End If End Sub '------------------------------------------------------------------------------------ 'Initialize the default or last saved options '------------------------------------------------------------------------------------ Private Sub Form_Load() Call LoadOption End Sub '------------------------------------------------------------------------------------ 'Allow a drag and drop of a file in the form '------------------------------------------------------------------------------------ Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Call EncryptDragDrop(Data, Effect) End Sub Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) Call EncryptDragOver(Data, Effect) End Sub '------------------------------------------------------------------------------------ 'Display the options form, saving them if the user click OK '------------------------------------------------------------------------------------ Private Sub mnuOption_Click() Dim xFrmOption As frmOption Set xFrmOption = New frmOption If xFrmOption.ShowForm(m_eEncryptionMethod, m_eEncryptionMode, m_ePaddingMethod, m_eHashingMethod, m_lKeySize) Then Call SaveOption End If Set xFrmOption = Nothing End Sub '------------------------------------------------------------------------------------ 'Quit the sample application '------------------------------------------------------------------------------------ Private Sub mnuQuit_Click() End End Sub '------------------------------------------------------------------------------------ 'Initialize the destination file to a default value if the destination 'text box is empty. '------------------------------------------------------------------------------------ Private Sub txtSourceFile_LostFocus() Call SetDestinationFileName End Sub '------------------------------------------------------------------------------------ 'Allow a drag and drop of a file in the source text box '------------------------------------------------------------------------------------ Private Sub txtSourceFile_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Call EncryptDragDrop(Data, Effect) End Sub Private Sub txtSourceFile_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) Call EncryptDragOver(Data, Effect) End Sub '==================================================================================== ' FUNCTIONS '==================================================================================== '=============================================== 'Utility functions '=============================================== '------------------------------------------------------------------------------------ 'Function that perform the actual encryption of a source file to a destination file '------------------------------------------------------------------------------------ Private Function EncryptFile(ByVal sSourceFileName As String, _ ByVal sEncryptedFileName As String) As Boolean Dim xEncryptor As XceedEncryption 'Our XceedEncryption object Dim lErrNumber As Long Dim sErrDesc As String Dim lBytesWritten As Long Dim lBytesRead As Long 'By default, this function returns false, assuming that an error will occur EncryptFile = False Me.MousePointer = vbHourglass 'Create an instance of the Xceed encryption Set xEncryptor = New XceedEncryption 'Clear the error message and status txtMessage.Text = "" lErrNumber = 0 'Create and prepare the encryption method If CreateEncryptionMethod(xEncryptor) Then ' Encrypt the file using On error... to catch any error thrown by the ' encryptor or by COM On Error Resume Next If m_eEncryptionMode = emoChainedBlocks Then 'User wants to encrypt in CBC mode. We set the initialization 'vector to a random value. Call xEncryptor.EncryptionMethod.SetRandomInitVector End If If Err.Number = 0 Then 'Process the file specifying : 'The source file name 'We want to encrypt the entire file 'Encrypt and it's the end of the data 'The destination file name and overwrite it 'The variable that will contain the number of bytes read lBytesWritten = xEncryptor.ProcessFile(sSourceFileName, _ 0, 0, _ efpEncrypt, True, _ sEncryptedFileName, False, _ lBytesRead) End If 'Keep the eventual error code and description as it is reset by the 'On error goto 0 lErrNumber = Err.Number sErrDesc = Err.Description On Error GoTo 0 If lErrNumber <> 0 Then 'Display the error that occured txtMessage.Text = sSourceFileName & " fail to encrypt" & vbCrLf & vbCrLf & _ sErrDesc & " (" & Hex(lErrNumber) & ")" Else 'Display a message of success EncryptFile = True txtMessage.Text = sSourceFileName & " successfully encrypted in " & sEncryptedFileName End If End If 'Deallocate the Encryption object. The encryption object will free 'the EncryptionMethod object. Set xEncryptor = Nothing Me.MousePointer = vbDefault End Function '------------------------------------------------------------------------------------ 'Function that perform the actual decryption of a source file to a destination file '------------------------------------------------------------------------------------ Private Function DecryptFile(ByVal sSourceFileName As String, _ ByVal sDecryptedFileName As String) As Boolean Dim xEncryptor As XceedEncryption 'Our XceedEncryption object Dim lErrNumber As Long Dim sErrDesc As String Dim lBytesWritten As Long Dim lBytesRead As Long 'By default, this function returns false, assuming that an error will occur DecryptFile = False Me.MousePointer = vbHourglass 'Create an instance of the Xceed encryption Set xEncryptor = New XceedEncryption txtMessage = "" lErrNumber = 0 'Create and prepare the encryption method If CreateEncryptionMethod(xEncryptor) Then ' Decrypt the file using On error... to catch any error thrown by the ' encryptor or by COM On Error Resume Next If Err.Number = 0 Then 'Process the file specifying : 'The source file name 'We want to decrypt the entire file 'Decrypt and it's the end of the data 'The destination file name and overwrite it 'The variable that will contain the number of bytes read lBytesWritten = xEncryptor.ProcessFile(sSourceFileName, _ 0, 0, _ efpDecrypt, True, _ sDecryptedFileName, False, _ lBytesRead) End If 'Keep the error informations before exiting the On error... section lErrNumber = Err.Number sErrDesc = Err.Description On Error GoTo 0 End If Set xEncryptor = Nothing If lErrNumber <> 0 Then 'Display the error that occured txtMessage.Text = sSourceFileName & " fail to decrypt" & vbCrLf & vbCrLf & _ sErrDesc & " (" & Hex(lErrNumber) & ")" Else 'The decryption succeeded. We return True DecryptFile = True txtMessage.Text = sSourceFileName & " successfully decrypted in " & sDecryptedFileName End If Me.MousePointer = vbDefault End Function '------------------------------------------------------------------------------------ 'Load in the member variables the options saved in the registry the last 'time this sample file manager was called. '------------------------------------------------------------------------------------ Private Sub LoadOption() m_eEncryptionMethod = Val(GetSetting("XceedEncryptionManager", "Encryption", "EncryptionMethod", Str(eemRijndael))) m_eEncryptionMode = Val(GetSetting("XceedEncryptionManager", "Encryption", "EncryptionMode", Str(emoFreeBlocks))) m_ePaddingMethod = Val(GetSetting("XceedEncryptionManager", "Encryption", "PaddingMethod", Str(epmFIPS81))) m_eHashingMethod = Val(GetSetting("XceedEncryptionManager", "Encryption", "HashingMethod", Str(ehmHaval))) m_lKeySize = Val(GetSetting("XceedEncryptionManager", "Encryption", "KeySize", Str(128))) End Sub '------------------------------------------------------------------------------------ 'Save the current options from the member variables in the registry '------------------------------------------------------------------------------------ Private Sub SaveOption() Call SaveSetting("XceedEncryptionManager", "Encryption", "EncryptionMethod", Str(m_eEncryptionMethod)) Call SaveSetting("XceedEncryptionManager", "Encryption", "EncryptionMode", Str(m_eEncryptionMode)) Call SaveSetting("XceedEncryptionManager", "Encryption", "PaddingMethod", Str(m_ePaddingMethod)) Call SaveSetting("XceedEncryptionManager", "Encryption", "HashingMethod", Str(m_eHashingMethod)) Call SaveSetting("XceedEncryptionManager", "Encryption", "KeySize", Str(m_lKeySize)) End Sub '------------------------------------------------------------------------------------ 'Function that perform the actual drop of a file on the form or the source text box '------------------------------------------------------------------------------------ Private Sub EncryptDragDrop(ByRef xData As DataObject, _ ByRef lEffect As Long) Dim sFile As Variant If xData.GetFormat(vbCFFiles) Then txtSourceFile.Text = xData.Files(1) Call SetDestinationFileName End If lEffect = vbDropEffectNone End Sub '------------------------------------------------------------------------------------ 'Function that perform the actual drag of a file on the form or the source text box 'Only modify the mouse cursor to show if it is permitted to drop. '------------------------------------------------------------------------------------ Private Sub EncryptDragOver(ByRef xData As DataObject, _ ByRef lEffect As Long) If xData.GetFormat(vbCFFiles) Then lEffect = vbDropEffectCopy Else lEffect = vbDropEffectNone End If End Sub '------------------------------------------------------------------------------------ 'Returns the path and file name without its extension '------------------------------------------------------------------------------------ Private Function RemoveFileExtension(ByVal sFilename As String) As String Dim I As Integer Dim nFileNameLen As Integer Dim nLenToTake As Integer nFileNameLen = Len(sFilename) I = nFileNameLen nLenToTake = -1 While I > 0 And nLenToTake = -1 Select Case Mid(sFilename, I, 1) Case "." nLenToTake = I - 1 Case "\" nLenToTake = nFileNameLen End Select I = I - 1 Wend If nLenToTake = -1 Then RemoveFileExtension = "" Else RemoveFileExtension = Left(sFilename, nLenToTake) End If End Function '------------------------------------------------------------------------------------ 'Assign a default value to the destination file name if the destination text box 'is empty. '------------------------------------------------------------------------------------ Private Sub SetDestinationFileName() Dim sEncryptedFileName As String sEncryptedFileName = txtDestinationFile.Text If Len(sEncryptedFileName) = 0 Then sEncryptedFileName = RemoveFileExtension(txtSourceFile.Text) If Len(sEncryptedFileName) <> 0 Then If m_eEncryptionMethod = eemRijndael Then txtDestinationFile.Text = sEncryptedFileName & ".aes" Else txtDestinationFile.Text = sEncryptedFileName & ".2fs" End If End If End If End Sub '==================================================================================== 'Functions - others '==================================================================================== '------------------------------------------------------------------------------------ 'Create a new instance of an encryption method according to the specified 'encryption method chosen in the option form (saved in the registry). 'Set some properties to the encryption method object appropriate for the selected 'encryption method and common the encryption and decryption since this function 'will be called before doing both. '------------------------------------------------------------------------------------ Private Function CreateEncryptionMethod(ByRef xEncryptor As XceedEncryption) As Boolean Dim bCreateOK As Boolean bCreateOK = True 'We instanciate a new encryption method, assigning it directly to the 'EncryptionMethod property of the XceedEncryption object. 'The drawbacks to this programming method are : ' - we don't have access to the code completion for the EncryptionMethod ' - setting a property of the EncryptionMethod (a VB Object, or COM ' IDispatch) will use the QueryInterface COM scheme which is less ' efficient than calling a property from a object of type ' XceedRijndaelEncryptionMethod for instance. 'To see an example of how it could be done more efficiently and with the 'help of code completion, consult the MemoryEncrypt sample application. On Error Resume Next 'Instanciate the right encryption method Select Case m_eEncryptionMethod Case eemRijndael Set xEncryptor.EncryptionMethod = New XceedRijndaelEncryptionMethod Case eemTwoFish Set xEncryptor.EncryptionMethod = New XceedTwofishEncryptionMethod End Select If Err.Number = 0 Then With xEncryptor.EncryptionMethod 'Set the hashing method that will be used to set the key from 'the pass phrase. Select Case m_eHashingMethod Case ehmHaval Set .HashingMethod = New XceedHavalHashingMethod If Err.Number = 0 Then 'Haval supports hash sizes equivalent to the supported 'key size. So, we can assign the latter to the 'former without problem. .HashingMethod.HashSize = m_lKeySize End If Case ehmSHA Set .HashingMethod = New XceedSHAHashingMethod If Err.Number = 0 Then 'We arbitrarily set the HashSize to the maximum key 'size allowed so we don't have to worry that the hash 'result of the pass phrase could be shorter than the 'expected key (although the Xceed Encryption Library 'would have deal with it). .HashingMethod.HashSize = 256 End If End Select If Err.Number = 0 Then 'Set the secret key of the desired size using the user pass phrase Call .SetSecretKeyFromPassPhrase(txtPassPhrase.Text, m_lKeySize) If Err.Number = 0 Then 'Set the encryption mode .EncryptionMode = m_eEncryptionMode If Err.Number = 0 Then 'Set the padding method (for the last encrypted or decrypted 'block) .PaddingMethod = m_ePaddingMethod End If End If End If End With End If If Err.Number <> 0 Then 'Display the error that occured txtMessage = txtMessage & " error initializing the encryption method" & vbCrLf & vbCrLf & _ Err.Description & " (" & Hex(Err.Number) & ")" & vbCrLf bCreateOK = False End If On Error GoTo 0 CreateEncryptionMethod = bCreateOK End Function 
(.txt)