Encriptador/Desencriptador .NET

Encriptador/Desencriptador .NET

Tabla de contenido

Intro

Aquí teneis un sencillo encriptador/desencriptador multi-archivo implementando el algoritmo de encriptación Rijndael de 256 bits. El encriptador está basado en el código de .

Simplemente abre un nuevo proyecto e introduce 3 botones, un ListView, una caja de texto y una barra de progreso.

Atención: Si no se utiliza la misma clave al desencriptar, el proceso de desencriptado se completa pero el archivo resultante será ilegible.

Código

Imports System
Imports System.IO
Imports System.Security
Imports System.Security.Cryptography

Public Class form1
    Dim ruta, rutabak As String
    Dim duplicado As Boolean = False

    Public Function CRC32(ByVal sFileName As String) As String
        Try
            Dim FS As FileStream = New FileStream(sFileName, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
            Dim CRC32Result As Integer = &HFFFFFFFF
            Dim Buffer(4096) As Byte
            Dim ReadSize As Integer = 4096
            Dim Count As Integer = FS.Read(Buffer, 0, ReadSize)
            Dim CRC32Table(256) As Integer
            Dim DWPolynomial As Integer = &HEDB88320
            Dim DWCRC As Integer
            Dim i As Integer, j As Integer, n As Integer

            'Create CRC32 Table
            For i = 0 To 255
                DWCRC = i
                For j = 8 To 1 Step -1
                    If (DWCRC And 1) Then
                        DWCRC = ((DWCRC And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                        DWCRC = DWCRC Xor DWPolynomial
                    Else
                        DWCRC = ((DWCRC And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                    End If
                Next j
                CRC32Table(i) = DWCRC
            Next i

            'Calcualting CRC32 Hash
            Do While (Count > 0)
                For i = 0 To Count - 1
                    n = (CRC32Result And &HFF) Xor Buffer(i)
                    CRC32Result = ((CRC32Result And &HFFFFFF00) \ &H100) And &HFFFFFF
                    CRC32Result = CRC32Result Xor CRC32Table(n)
                Next i
                Count = FS.Read(Buffer, 0, ReadSize)
            Loop
            Return Hex(Not (CRC32Result))
        Catch ex As Exception
            Return ""
        End Try
    End Function
   
    Private Sub form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        With ListView1
            .View = View.Details
            .FullRowSelect = True
            .MultiSelect = False
            .HideSelection = False
            .LabelEdit = False
            .Columns.Add("Archivo", 150)
            .Columns.Add("KBs", 60)
            .Columns.Add("CRC32", 70)
            .Columns.Add("Ruta", 120)
        End With
        '
        Me.Text = "Encriptador [" & Application.ProductVersion & "]"
        '
    End Sub
    
    Private Sub ListView1_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListView1.DragDrop
        Try
            If e.Data.GetDataPresent(DataFormats.FileDrop) Then
                Dim filePaths As String() = CType(e.Data.GetData(DataFormats.FileDrop), String())
                For Each filePath As String In filePaths
                    'Compruebo duplicados
                    For i = 0 To ListView1.Items.Count - 1
                        If ListView1.Items(i).SubItems(2).Text = CRC32(filePath) Then
                            duplicado = True
                        End If
                    Next
                    If duplicado = False Then
                        Dim chkExt As String = My.Computer.FileSystem.GetFileInfo(filePath).Extension
                        Dim chkSize As String = My.Computer.FileSystem.GetFileInfo(filePath).Length
                        chkSize = chkSize / 1024
                        Dim d As Decimal
                        d = Decimal.Round(chkSize, 2, MidpointRounding.AwayFromZero)
                        Dim LI As ListViewItem
                        LI = ListView1.Items.Add(My.Computer.FileSystem.GetFileInfo(filePath).Name)
                        LI.StateImageIndex = 0
                        LI.SubItems.Add(d & " KB")
                        LI.SubItems.Add(CRC32(filePath))
                        LI.SubItems.Add(filePath)
                    End If
                    duplicado = False
                Next filePath
            End If
        Catch ex As Exception
            MsgBox("Ocurrió el siguiente error: " & ex.Message.ToString)
        End Try
    End Sub
    
    Private Sub ListView1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListView1.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.None
        End If
    End Sub
    
    Private Function Copiar(ByVal path As String, ByVal path2 As String) As Boolean
        Dim sr As New IO.FileStream(path, IO.FileMode.Open, FileAccess.Read) 'lugar de origen
        Dim sw As New IO.FileStream(path2, IO.FileMode.Create, FileAccess.ReadWrite) 'lugar de destino
        Dim len As Long = sr.Length - 1
        For i As Long = 0 To len
            sw.WriteByte(sr.ReadByte)
            If i Mod 1000 = 0 Then
                pbstatus.Value = i * 100 / len
                Application.DoEvents()
            End If
        Next
        pbstatus.Value = 0
        sr.Close()
        sr.Dispose()
        sw.Close()
        sw.Dispose()
        Return True
    End Function
    
    Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'BOTÓN ENCRIPTAR
        Try
            If txtpw.Text <> "" And txtpw.TextLength > 5 Then
                If ListView1.Items.Count > 0 Then
                    Me.Cursor = Cursors.WaitCursor
                    Application.DoEvents()
                    For i = 0 To ListView1.Items.Count - 1
                        ruta = ListView1.Items(i).SubItems(3).Text
                        rutabak = ListView1.Items(i).SubItems(3).Text & "_enc"
                        Do While Copiar(ruta, rutabak) = False
                            'espere
                        Loop
                        Dim bytKey As Byte()
                        Dim bytIV As Byte()
                        bytKey = CreateKey(txtpw.Text)
                        bytIV = CreateIV(txtpw.Text)
                        EncryptOrDecryptFile(ruta, rutabak, bytKey, bytIV, CryptoAction.ActionEncrypt)
                        '
                    Next
                Else
                    MsgBox("Lista de archivos vacía")
                End If
            Else
                MsgBox("Clave no válida" & vbNewLine & "Debe tener al menos 6 dígitos")
            End If
            Me.Cursor = Cursors.Default
            Application.DoEvents()
        Catch ex As Exception
            MsgBox("Ocurrió el siguiente error: " & ex.Message.ToString)
            Me.Cursor = Cursors.Default
            Application.DoEvents()
        End Try
    End Sub
    
    Private Sub Button2_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        'BOTÓN DES-ENCRIPTAR
        Try
            If txtpw.Text <> "" And txtpw.TextLength > 5 Then
                If ListView1.Items.Count > 0 Then
                    For i = 0 To ListView1.Items.Count - 1
                        Me.Cursor = Cursors.WaitCursor
                        Application.DoEvents()
                        ruta = ListView1.Items(i).SubItems(3).Text
                        'rutabak = ListView1.Items(i).SubItems(3).Text & "_enc"
                        rutabak = ruta.Remove(ruta.Length - 4)
                        Do While Copiar(ruta, rutabak) = False
                            'espere
                        Loop
                        'DecryptFile(ruta, rutabak, txtpw.Text)
                        '
                        Dim bytKey As Byte()
                        Dim bytIV As Byte()
                        bytKey = CreateKey(txtpw.Text)
                        bytIV = CreateIV(txtpw.Text)
                        EncryptOrDecryptFile(ruta, rutabak, bytKey, bytIV, CryptoAction.ActionDecrypt)
                    Next
                Else
                    MsgBox("Lista de archivos vacía")
                End If
            Else
                MsgBox("Clave no válida" & vbNewLine & "Debe tener al menos 6 dígitos")
            End If
            Me.Cursor = Cursors.Default
            Application.DoEvents()
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
            Me.Cursor = Cursors.Default
            Application.DoEvents()
        End Try
    End Sub
    
    Private Sub btn_vaciar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn_vaciar.Click
        'BOTÓN VACIAR
        ListView1.Items.Clear()
        pbstatus.Value = 0
    End Sub

    Private Sub ListView1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles ListView1.KeyDown
        Try
            If e.KeyCode = Keys.Delete Then
                For Each i As ListViewItem In ListView1.SelectedItems
                    ListView1.Items.Remove(i)
                Next
            End If
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub
    
#Region "1. Global Variables "

    '*************************
    '** Global Variables
    '*************************

    Dim strFileToEncrypt As String
    Dim strFileToDecrypt As String
    Dim strOutputEncrypt As String
    Dim strOutputDecrypt As String
    Dim fsInput As System.IO.FileStream
    Dim fsOutput As System.IO.FileStream

#End Region

#Region "2. Create A Key "

    '*************************
    '** Create A Key
    '*************************

    Private Function CreateKey(ByVal strPassword As String) As Byte()
        Dim chrData() As Char = strPassword.ToCharArray
        Dim intLength As Integer = chrData.GetUpperBound(0)
        Dim bytDataToHash(intLength) As Byte
        For i As Integer = 0 To chrData.GetUpperBound(0)
            bytDataToHash(i) = CByte(Asc(chrData(i)))
        Next
        Dim SHA512 As New System.Security.Cryptography.SHA512Managed
        Dim bytResult As Byte() = SHA512.ComputeHash(bytDataToHash)
        'Declare bytKey(31).  It will hold 256 bits.
        Dim bytKey(31) As Byte
        For i As Integer = 0 To 31
            bytKey(i) = bytResult(i)
        Next
        Return bytKey 'Return the key.
    End Function

#End Region

#Region "3. Create An IV "

    '*************************
    '** Create An IV
    '*************************

    Private Function CreateIV(ByVal strPassword As String) As Byte()
        Dim chrData() As Char = strPassword.ToCharArray
        Dim intLength As Integer = chrData.GetUpperBound(0)
        Dim bytDataToHash(intLength) As Byte
        For i As Integer = 0 To chrData.GetUpperBound(0)
            bytDataToHash(i) = CByte(Asc(chrData(i)))
        Next
        Dim SHA512 As New System.Security.Cryptography.SHA512Managed
        'Declare bytResult, Hash bytDataToHash and store it in bytResult.
        Dim bytResult As Byte() = SHA512.ComputeHash(bytDataToHash)
        'Declare bytIV(15).  It will hold 128 bits.
        Dim bytIV(15) As Byte
        For i As Integer = 32 To 47
            bytIV(i - 32) = bytResult(i)
        Next
        Return bytIV 'return the IV
    End Function

#End Region


#Region "4. Encrypt / Decrypt File "

    '****************************
    '** Encrypt/Decrypt File
    '****************************

    Private Enum CryptoAction
        ActionEncrypt = 1
        ActionDecrypt = 2
    End Enum

    Private Sub EncryptOrDecryptFile(ByVal strInputFile As String, _
                                     ByVal strOutputFile As String, _
                                     ByVal bytKey() As Byte, _
                                     ByVal bytIV() As Byte, _
                                     ByVal Direction As CryptoAction)
        Try
            fsInput = New System.IO.FileStream(strInputFile, FileMode.Open, _
                                               FileAccess.Read)
            fsOutput = New System.IO.FileStream(strOutputFile, FileMode.OpenOrCreate, _
                                                FileAccess.Write)
            fsOutput.SetLength(0) 'make sure fsOutput is empty
            Dim bytBuffer(4096) As Byte 'holds a block of bytes for processing
            Dim lngBytesProcessed As Long = 0 'running count of bytes processed
            Dim lngFileLength As Long = fsInput.Length 'the input file's length
            Dim intBytesInCurrentBlock As Integer 'current bytes being processed
            Dim csCryptoStream As CryptoStream
            'Declare your CryptoServiceProvider.
            Dim cspRijndael As New System.Security.Cryptography.RijndaelManaged
            pbStatus.Value = 0
            pbStatus.Maximum = 100

            Select Case Direction
                Case CryptoAction.ActionEncrypt
                    csCryptoStream = New CryptoStream(fsOutput, _
                    cspRijndael.CreateEncryptor(bytKey, bytIV), _
                    CryptoStreamMode.Write)

                Case CryptoAction.ActionDecrypt
                    csCryptoStream = New CryptoStream(fsOutput, _
                    cspRijndael.CreateDecryptor(bytKey, bytIV), _
                    CryptoStreamMode.Write)
            End Select

            While lngBytesProcessed < lngFileLength
                'Read file with the input filestream.
                intBytesInCurrentBlock = fsInput.Read(bytBuffer, 0, 4096)
                'Write output file with the cryptostream.
                csCryptoStream.Write(bytBuffer, 0, intBytesInCurrentBlock)
                'Update lngBytesProcessed
                lngBytesProcessed = lngBytesProcessed + CLng(intBytesInCurrentBlock)
                'Update Progress Bar
                pbStatus.Value = CInt((lngBytesProcessed / lngFileLength) * 100)
            End While

            csCryptoStream.Close()
            fsInput.Close()
            fsOutput.Close()

            If Direction = CryptoAction.ActionEncrypt Then
                Dim fileOriginal As New FileInfo(strFileToEncrypt)
                fileOriginal.Delete()
            End If

            If Direction = CryptoAction.ActionDecrypt Then
                Dim fileEncrypted As New FileInfo(strFileToDecrypt)
                fileEncrypted.Delete()
            End If

            Dim Wrap As String = Chr(13) + Chr(10)
            If Direction = CryptoAction.ActionEncrypt Then
                MsgBox("Encryption Complete" + Wrap + Wrap + _
                        "Total bytes processed = " + _
                        lngBytesProcessed.ToString, _
                        MsgBoxStyle.Information, "Done")
                pbStatus.Value = 0
            Else
                pbStatus.Value = 0
            End If


            'Catch file not found error.
        Catch When Err.Number = 53 'if file not found
            MsgBox("Please check to make sure the path and filename" + _
                    "are correct and if the file exists.", _
                     MsgBoxStyle.Exclamation, "Invalid Path or Filename")

        Catch
            fsInput.Close()
            fsOutput.Close()

        End Try
    End Sub

#End Region
End Class

Vídeo

Enlaces

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

catorce + dos =