La cryptographie en VB.NET

Public Class ChiffreEventArgs

    Inherits System.EventArgs
    Private m_Realize, m_Total As Long

    Public Sub New(ByVal ValRealise As Long, ByVal ValTotal As Long)
        Me.m_Realize = ValRealise
        Me.m_Total = ValTotal
    End Sub

    Public ReadOnly Property Total() As Long
        Get
            Return Me.m_Total
        End Get
    End Property

    Public ReadOnly Property Realise() As Long
        Get
            Return Me.m_Realize
        End Get
    End Property

End Class

Imports Microsoft.Win32
Imports System.IO
Imports System.Security
Imports System.Security.Permissions
Imports System.Security.Cryptography

<Assembly: RegistryPermission(SecurityAction.RequestMinimum, All:="HKEY_CURRENT_USER\SOFTWARE\Secure")> 
<Assembly: FileIOPermission(SecurityAction.RequestMinimum, Unrestricted:=True)>

Public Class CryptFile
    'Déclaration des délégués pour le suivi de l'opération asynchrone
    Delegate Sub StartChiffreEventHandler(ByVal sender As Object, ByVal e As ChiffreEventArgs)
    Delegate Sub EndChiffreEventHandler(ByVal sender As Object, ByVal e As ChiffreEventArgs)
    Delegate Sub ProgressChiffreEventHandler(ByVal sender As Object, ByVal e As ChiffreEventArgs)
    'Déclaration des évènements pour le suivi de l'opération asynchrone
    Public Event StartChiffreEvent As StartChiffreEventHandler
    Public Event EndChiffreEvent As EndChiffreEventHandler
    Public Event ProgressChiffreEvent As ProgressChiffreEventHandler

    Private RegApp As RegistryKey
    Private STDES As TripleDESCryptoServiceProvider
    Public Sub New()
        
'vérification du registre
        RegApp = Registry.CurrentUser.OpenSubKey("Software\\Secure\\chPers", True)
        STDES = New TripleDESCryptoServiceProvider
        If RegApp Is Nothing Then 'les clés de registre n'existent pas
            With STDES 'je génère une clé de chiffrement et un vecteur
                .GenerateIV()
                .GenerateKey()
            End With
            'je les mets dans le registre
            RegApp = Registry.CurrentUser.CreateSubKey("Software\\Secure\\chPers")
            RegApp.SetValue("cle", Convert.ToBase64String(STDES.Key))
            RegApp.SetValue("vecteur", Convert.ToBase64String(STDES.IV))
        Else 'les clés de registre existent
            With STDES 'je récupère les valeurs du registre
                .Key = Convert.FromBase64String(CType(RegApp.GetValue("cle"), String))
                .IV = Convert.FromBase64String(CType(RegApp.GetValue("vecteur"), String))
            End With
        End If

    End Sub

    Public Sub chiffrement(ByVal Fichier As String)

        If File.Exists(Fichier) Then
            Dim FichierSource As New FileStream(Fichier, FileMode.Open, FileAccess.Read)
            Dim FichierCible As New FileStream(Path.ChangeExtension(Fichier, "cry"), _
 FileMode.Create, FileAccess.Write)
            Dim ChiffreFlux As New CryptoStream(FichierCible, STDES.CreateEncryptor, CryptoStreamMode.Write)
            FichierCible.SetLength(0)
            Dim bin(100) As Byte
            Dim LongTotale As Long = FichierSource.Length
            RaiseEvent StartChiffreEvent(Me, New ChiffreEventArgs(0, LongTotale))
            Dim LongEffectue As Long = 0
            Dim BlocLen As Integer
            'traitement
            While LongEffectue < LongTotale
                BlocLen = FichierSource.Read(bin, 0, 100)
                ChiffreFlux.Write(bin, 0, BlocLen)
                LongEffectue += BlocLen
                RaiseEvent ProgressChiffreEvent(Me, New ChiffreEventArgs(LongEffectue, LongTotale))
            End While
            RaiseEvent EndChiffreEvent(Me, New ChiffreEventArgs(LongEffectue, LongTotale))
            ChiffreFlux.Close()
            FichierSource.Close()
            FichierCible.Close()
        Else
            Throw New FileNotFoundException("Le fichier n'a pas été trouvé", Fichier)
        End If

    End Sub

    Public Sub Dechiffrement(ByVal Fichier As String, ByVal ExtensionCible As String)

        If File.Exists(Fichier) Then
            Dim FichierSource As New FileStream(Fichier, FileMode.Open, FileAccess.Read)
            Dim FichierCible As New FileStream(Path.ChangeExtension(Fichier, ExtensionCible), _
 FileMode.Create, FileAccess.Write)
            Dim ChiffreFlux As New CryptoStream(FichierCible, STDES.CreateDecryptor, CryptoStreamMode.Write)
            FichierCible.SetLength(0)
            Dim bin(100) As Byte
            Dim LongTotale As Long = FichierSource.Length
            RaiseEvent StartChiffreEvent(Me, New ChiffreEventArgs(0, LongTotale))
            Dim LongEffectue As Long = 0
            Dim BlocLen As Integer
            'traitement
            While LongEffectue < LongTotale
                BlocLen = FichierSource.Read(bin, 0, 100)
                ChiffreFlux.Write(bin, 0, BlocLen)
                LongEffectue += BlocLen
                RaiseEvent ProgressChiffreEvent(Me, New ChiffreEventArgs(LongEffectue, LongTotale))
            End While
            RaiseEvent EndChiffreEvent(Me, New ChiffreEventArgs(LongEffectue, LongTotale))
            ChiffreFlux.Close()
            FichierSource.Close()
            FichierCible.Close()
        Else
            Throw New FileNotFoundException("Le fichier n'a pas été trouvé", Fichier)
        End If

    End Sub

End Class

Dim ChiffreFlux As New CryptoStream(FichierClair, STDES.CreateDecryptor, CryptoStreamMode.Write)

Private Sub cmdCryptFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
 Handles cmdCryptFile.Click
    Dim MonFichier As String
    With Me.OpenFileDialog1
        .CheckFileExists = True
        .DefaultExt = "doc"
        .Filter = "Documents Word (*.doc)|*.doc|Fichiers texte (*.txt)|*.txt|Tous les fichiers (*.*)|*.*"
        .FilterIndex = 1
        .Multiselect = False
        .Title = "Selection du fichier à chiffrer"
        If .ShowDialog(Me) = DialogResult.OK Then
            MonFichier = .FileName
        End If
    End With
    Try
        Dim objChiffre As New Crypto.CryptFile
        AddHandler objChiffre.StartChiffreEvent, AddressOf Operation_StartChiffreEvent
        AddHandler objChiffre.ProgressChiffreEvent, AddressOf Operation_ProgressChiffreEvent
        AddHandler objChiffre.EndChiffreEvent, AddressOf Operation_EndChiffreEvent
        objChiffre.chiffrement(MonFichier)
    Catch ex As Exception
        MsgBox("Erreur lors de l'opération", MsgBoxStyle.Critical And MsgBoxStyle.OKOnly, "ERREUR")
    End Try

End Sub  

Private Sub Operation_StartChiffreEvent(ByVal sender As Object, ByVal e As Crypto.ChiffreEventArgs)
    With Me.lblChiffrement
        .Text = "Opération en cours..."
        .Visible = True
    End With
    Me.pgbChiffrement.Visible = True
End Sub

Private Sub Operation_ProgressChiffreEvent(ByVal sender As Object, ByVal e As Crypto.ChiffreEventArgs)
    Me.pgbChiffrement.Value = CInt(e.Realise / e.Total * 100)
End Sub

Private Sub Operation_EndChiffreEvent(ByVal sender As Object, ByVal e As Crypto.ChiffreEventArgs)
    Me.lblChiffrement.Visible = False
    Me.pgbChiffrement.Visible = False
End Sub

Public Sub New(ByVal Cle() As Byte, ByVal Vecteur() As Byte)
    'création d'un service avec des valeurs externes
    STDES = New TripleDESCryptoServiceProvider
    With STDES
        .Key = Cle
        .IV = Vecteur
    End With
End Sub

Public Class RSAPaire
    Private m_Magasin As String
    Private m_RSA As RSACryptoServiceProvider

    Public Sub New(ByVal NomMagasin As String, ByVal CreerMagasin As Boolean)

        m_Magasin = NomMagasin
        If CreerMagasin Then CreateMagasin() Else RecupMagasin()

    End Sub

    Public Sub New(ByVal ImportString As String)
        m_RSA = New System.Security.Cryptography.RSACryptoServiceProvider
        m_RSA.FromXmlString(ImportString)
    End Sub

    Private Sub CreateMagasin()
        Dim cspParam As CspParameters = New CspParameters
        cspParam.KeyContainerName = m_Magasin
        m_RSA = New System.Security.Cryptography.RSACryptoServiceProvider(cspParam)
        m_RSA.PersistKeyInCsp = True

    End Sub

    Private Sub RecupMagasin()
        Dim cspParam As CspParameters = New CspParameters
        cspParam.KeyContainerName = m_Magasin
        m_RSA = New System.Security.Cryptography.RSACryptoServiceProvider(cspParam)
    End Sub

    Public Function ExportPublicKey() As String
        Return m_RSA.ToXmlString(False)
    End Function

    Public Function CryptData(ByVal DonneeClaire() As Byte) As Byte()
        Return m_RSA.Encrypt(DonneeClaire, False)
    End Function

    Public Function DecryptData(ByVal DonneeChiffree() As Byte) As Byte()
        Return m_RSA.Decrypt(DonneeChiffree, False)
    End Function

End Class

    Private Sub cmdExportPubKey_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
 Handles cmdExportPubKey.Click
        Dim objRsa As New Crypto.RSAPaire("neo", True)
        Me.txtPublicKey.Text = objRsa.ExportPublicKey
    End Sub

Private Sub cmdRSACrypt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
 Handles cmdRSACrypt.Click

    Dim objRsa As New Crypto.RSAPaire(Me.txtPublicKey.Text)
    Dim RegApp As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\\Secure\\chPers", True)
    Dim CryptCleSym() As Byte
    Dim CryptVecSym() As Byte
    CryptCleSym = objRsa.CryptData(Convert.FromBase64String(CType(RegApp.GetValue("cle"), String)))
    CryptVecSym = objRsa.CryptData(Convert.FromBase64String(CType(RegApp.GetValue("vecteur"), String)))
    Me.txtCleSymCry.Text = Convert.ToBase64String(CryptCleSym)
    Me.txtVecSymCry.Text = Convert.ToBase64String(CryptVecSym)

End Sub

Private Sub cmdDecryptKeyAndFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
 Handles cmdDecryptKeyAndFile.Click
    Dim objRsa As New Crypto.RSAPaire("neo", False)
    Dim DecryptCleSym() As Byte
    Dim DecryptVecSym() As Byte
    DecryptCleSym = objRsa.DecryptData(Convert.FromBase64String(Me.txtCleSymCry.Text))
    DecryptVecSym = objRsa.DecryptData(Convert.FromBase64String(Me.txtVecSymCry.Text))
    Dim MonFichier As String
    With Me.OpenFileDialog1
        .CheckFileExists = True
        .DefaultExt = "cry"
        .Filter = "Fichiers chiffrés (*.cry)|*.cry"
        .FilterIndex = 1
        .Multiselect = False
        .Title = "Selection du fichier à déchiffrer"
        If .ShowDialog(Me) = DialogResult.OK Then
            MonFichier = .FileName
        End If
    End With
    Try
        Dim objChiffre As New Crypto.CryptFile(DecryptCleSym, DecryptVecSym)
        AddHandler objChiffre.StartChiffreEvent, AddressOf Operation_StartChiffreEvent
        AddHandler objChiffre.ProgressChiffreEvent, AddressOf Operation_ProgressChiffreEvent
        AddHandler objChiffre.EndChiffreEvent, AddressOf Operation_EndChiffreEvent
        objChiffre.Dechiffrement(MonFichier, "doc")
    Catch ex As Exception
        MsgBox("Erreur lors de l'opération", MsgBoxStyle.Critical And MsgBoxStyle.OKOnly, "ERREUR")
    End Try

End Sub

    Private Sub cmdOK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdOK.Click
        Dim SHA As New SHA256Managed
        Dim UniEnc As New System.Text.UnicodeEncoding
        Dim bitPass() As Byte = UniEnc.GetBytes(Me.txtPassword.Text)
        If Convert.ToBase64String(SHA.ComputeHash(bitPass)) = "ew9LkdvpuYaurqPCDV3rWGZ1vTaD3GfN6b441cA0TNQ=" Then
            Me.DialogResult = DialogResult.OK
        Else
            Me.DialogResult = DialogResult.Cancel
        End If
    End Sub

  …
    <credentials>
      <User Name="Jean-Marc" Password="ew9LkdvpuYaurqPCDV3rWGZ1vTaD3GfN6b441cA0TNQ=" /> 
      <User Name="Morpheus" Password="ew9LkdvpuYaurqPCDV3rWGZ1vTaD3GfN6b441cA0TNQ=" /> 
      <User Name="Neo.51" Password="ew9LkdvpuYaurqPCDV3rWGZ1vTaD3GfN6b441cA0TNQ=" /> 
   …
      </ credentials >

<Flags()> Private Enum Conforme
                  HasLower = 1
                  HasUpper = 2
                  HasNumber = 4
                  HasOther = 8
        End Enum 

Private Sub txtNewPass_Validating(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
 Handles txtNewPass.Validating
    If Me.txtNewPass.Text.Length < 12 Then
        e.Cancel = True
        Me.ErrorProvider1.SetError(Me.txtNewPass, "Le mot de passe doit contenir au moins 12 caractères")
    End If
    Dim Verif As New Conforme
    Dim tabChar() As Char = Me.txtNewPass.Text.ToCharArray
    For cmpt As Integer = tabChar.GetLowerBound(0) To tabChar.GetUpperBound(0)
        Select Case True

            Case Char.IsPunctuation(tabChar(cmpt)) OrElse Char.IsSymbol(tabChar(cmpt))
                Verif = Verif Or Conforme.HasOther

            Case Char.IsLower(tabChar(cmpt))
                Verif = Verif Or Conforme.HasLower

            Case Char.IsUpper(tabChar(cmpt))
                Verif = Verif Or Conforme.HasUpper

            Case Char.IsNumber(tabChar(cmpt))
                Verif = Verif Or Conforme.HasNumber

        End Select
    Next
    If Verif < 15 Then
        e.Cancel = True 
        Me.ErrorProvider1.SetError(Me.txtNewPass, _ 
"Le mot de passe doit contenir au moins une majuscule, une minuscule un chiffre et un symbole")
    End If
End Sub

Private Sub cmdAccCryptData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
 Handles cmdAccCryptData.Click

    Dim CryptXML As New FileStream(Application.StartupPath & "\biblio.cry", FileMode.Open)
    Dim pdb As New Security.Cryptography.PasswordDeriveBytes(Me.txtPass.Text, _
 New Byte(7) {21, 10, 16, 21, 32, 2, 78, 9})
    With pdb
        .HashName = "SHA256"
        .IterationCount = 722
    End With
    Dim Prov3DES As New TripleDESCryptoServiceProvider
    With Prov3DES
        .Key = pdb.GetBytes(24)
        .IV = pdb.GetBytes(8)
    End With
    Dim CryptFlux As New CryptoStream(CryptXML, Prov3DES.CreateDecryptor, CryptoStreamMode.Read)
    Dim MonDs As New DataSet
    MonDs.ReadXml(CryptFlux, XmlReadMode.ReadSchema)
    Me.DataGrid1.DataSource = MonDs

End Sub

Public Class ExtractInfo
    Private m_info1, m_info2, m_info3 As String

    Public Sub New()

        m_info1 = GetMacAddress()
        m_info2 = GetDiskSerial()
        m_info3 = GetProcessorRef()

    End Sub

    Private Function GetMacAddress() As String

        Dim NetClass As New System.Management.ManagementClass("Win32_NetworkAdapterConfiguration")
        Dim Nets As ManagementObjectCollection = NetClass.GetInstances
        Dim Net As ManagementObject
        For Each Net In Nets
            GetMacAddress = Net("MacAddress").ToString
            Exit For
        Next Net

    End Function

    Private Function GetDiskSerial() As String

        Dim diskClass As New System.Management.ManagementClass("Win32_LogicalDisk")
        Dim disks As System.Management.ManagementObjectCollection = diskClass.GetInstances()
        Dim disk As System.Management.ManagementObject
        For Each disk In disks
            If CStr(disk("Name")) = "C:" Then
                GetDiskSerial = disk("VolumeSerialNumber").ToString
            End If
        Next disk

    End Function

    Private Function GetProcessorRef() As String

        Dim ProcClass As New System.Management.ManagementClass("Win32_Processor")
        Dim Procs As ManagementObjectCollection = ProcClass.GetInstances
        Dim Proc As ManagementObject
        For Each Proc In Procs
            GetProcessorRef = Proc("ProcessorId").ToString
            Exit For
        Next Proc

    End Function

    Public Function EmissionCle(ByVal Pbk As String) As Byte()
        Dim mRSA As New RSACryptoServiceProvider
        mRSA.FromXmlString(Pbk)
        Dim UEnc As New System.Text.UnicodeEncoding
        Dim strTest As String = Me.m_info1 & "|" & Me.m_info2 & "|" & Me.m_info3
        Dim TabByte() As Byte = UEnc.GetBytes(strTest)
        Return mRSA.Encrypt(TabByte, False)
    End Function

    Public Function VerifyKey(ByVal Test As String) As Boolean

        Dim cmpt As Integer
        Dim TabByte(23), rndByte() As Byte, Verif() As Byte
        Dim dEnc As New System.Text.ASCIIEncoding
        dEnc.GetBytes(m_info1.Substring(4, 2)).CopyTo(TabByte, 0)
        ReDim Verif(1)
        dEnc.GetBytes(m_info1.Substring(6, 2)).CopyTo(Verif, 0)
        dEnc.GetBytes(m_info2.Substring(0, 5)).CopyTo(TabByte, 2)
        cmpt = 1 + m_info2.Length - 6
        ReDim Preserve Verif(cmpt)
        dEnc.GetBytes(m_info2.Substring(6)).CopyTo(Verif, 2)
        dEnc.GetBytes(m_info3.Substring(0, 5)).CopyTo(TabByte, 8)
        ReDim Preserve Verif(cmpt + m_info3.Length - 6)
        dEnc.GetBytes(m_info3.Substring(6)).CopyTo(Verif, cmpt + 1)
        rndByte = Convert.FromBase64String( _ 
Registry.CurrentUser.OpenSubKey("Software\\Secure\\Share").GetValue("part").ToString)
        rndByte.CopyTo(TabByte, 14)
        dEnc.GetBytes(m_info1.Substring(8, 2)).CopyTo(TabByte, 22)
        Dim m3DES As New TripleDESCryptoServiceProvider
        m3DES.Key = TabByte
        m3DES.IV = New Byte(7) {Verif(0), Verif(1), Verif(2), Verif(3), Verif(4), Verif(5), Verif(6), Verif(7)}
        Dim ms As New IO.MemoryStream
        Dim CryptFlux As New CryptoStream(ms, m3DES.CreateEncryptor, CryptoStreamMode.Write)
        CryptFlux.Write(System.Text.UnicodeEncoding.Unicode.GetBytes(Test), 0, Test.Length)
        Dim PassByte As Byte() = ms.ToArray
        If String.Compare(Registry.CurrentUser.OpenSubKey("Software\\Secure\\Share") _ 
.GetValue("ver").ToString, Convert.ToBase64String(PassByte)) <> 0 Then
            Return False
        Else
            Return True
        End If

    End Function

End Class