modCrypt

modCrypt:
Met deze module kun je eenvoudig en zeer veilig losse gegevens en/of bestanden versleutelen.
    Encrypt = versleutelen
    Decrypt = ontsleutelen
Doormiddel van een zelf te wijzigen SubKey of Wachtwoord wordt, vanuit een basis Key, een unieke 256 Bits Key samengesteld.

Project NAW - modCrypt.vb

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

Public Module Crypt

' '' Encrypt/Decrypt byte-array, string en file met unieke 256 Bits Key
' '' Lossse data geeft bij een fout de string "Fout" terug
' '' Bij bestanden wordt een code geretouneerd
Private algorithm As Rijndael = Rijndael.Create()
Private Key As Byte()
Private IV As Byte() = {38, 108, 24, 216, 222, 181, 118, 68, 177, 45, 239, 211, 175, 151, 38, 77}
Const Fout As String = "(ERROR)"
#Const Compile = False
'#Const Compile = true

Public Function PasswordOk(ByVal ToDecrypt As String, ByVal Password As String) As Boolean
' '' Test password
' '' ToDecrypt: versleutelde wachtwoord
' '' Password: door gebruiker ingegeven wachtwoord
Return Decrypt(ToDecrypt, Password) <> Fout
End Function

Private Sub MakeKey(ByVal Sleutel As String)
' '' Maakt unieke Key van basis-Key en Sleutel (SubKey of Sleutel)
If Sleutel.Length > 32 Then Sleutel = Sleutel.Substring(0, 31)
Dim SleutelBytes As Byte() = Encoding.UTF8.GetBytes(Sleutel)
    Key = New Byte() {13, 28, 18, 114, 33, 100, 175, 128, 171, 216, 33, 62, 55, 189, 214, 104, _
                      241, 53, 46, 15, 99, 112, 104, 10, 6, 153, 52, 172, 86, 218, 40, 100}
    Array.Copy(SleutelBytes, Key, SleutelBytes.Length)
End Sub

#If Compile Then

Private Function Filetest(ByVal fileIn As String, ByVal fileOut As String) As Integer
' '' Return: 1 = no FileIn, 2 = user cancelled
If Not File.Exists(fileIn) Then Return 1
If File.Exists(fileOut) AndAlso MsgBox("re-write " & fileOut, _
                MsgBoxStyle.Information Or MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then Return 2
End Function

#End If

#Region "Encrypt"

Public Function Encrypt(ByVal ToEncryptData As Byte()) As Byte()
Dim encryptedData As Byte() = Encoding.Unicode.GetBytes(Fout)
Dim MemStream As New MemoryStream()
Try
algorithm.Key = Key
      algorithm.IV = IV
Dim CryptStream As CryptoStream = New CryptoStream(MemStream, algorithm.CreateEncryptor(), _
                                                         CryptoStreamMode.Write)
      CryptStream.Write(ToEncryptData, 0, ToEncryptData.Length)
      CryptStream.Close()
      encryptedData = MemStream.ToArray()
      CryptStream.Dispose()
Return encryptedData
Catch ex As Exception
Return encryptedData
Finally
MemStream.Close()
      MemStream.Dispose()
End Try
End Function

Public Function Encrypt(ByVal ToEncryptText As String, ByVal Sleutel As String) As String
MakeKey(Sleutel)
Dim EncryptBytes As Byte() = Encoding.Unicode.GetBytes(ToEncryptText)
Dim encryptedData As Byte() = Encrypt(EncryptBytes)
Return Convert.ToBase64String(encryptedData)
End Function

#If Compile Then

Public Function Encrypt(ByVal ToEncryptData As Byte(), ByVal Sleutel As String) As Byte()
    MakeKey(Sleutel)
Return Encrypt(ToEncryptData)
End Function

Public Function Encrypt(ByVal fileIn As String, ByVal fileOut As String, _
ByVal Sleutel As String) As Integer
' '' Return: -1 = OK, 0 = read/write Error, 1 = no FileIn, 2 = user cancelled
Dim i As Integer = Filetest(fileIn, fileOut) > 0
If i > 0 Then Return i
    MakeKey(Sleutel)
Dim FileStreamIn As New FileStream(fileIn, FileMode.Open, FileAccess.Read)
Dim FileStreamOut As New FileStream(fileOut, FileMode.OpenOrCreate, FileAccess.Write)
Try
algorithm.Key = Key
      algorithm.IV = IV
Dim CryptStream As CryptoStream = New CryptoStream(FileStreamOut, _
                                            algorithm.CreateEncryptor(), CryptoStreamMode.Write)
Dim bufferLen As Integer = 4096
Dim buffer As Byte() = New Byte(bufferLen - 1) {}
Dim bytesRead As Integer
Do
bytesRead = FileStreamIn.Read(buffer, 0, bufferLen)
        CryptStream.Write(buffer, 0, bytesRead)
Loop While bytesRead <> 0
      CryptStream.Close()
      CryptStream.Dispose()
Return -1
Catch ex As Exception
Return 0
Finally
FileStreamOut.Close()
      FileStreamIn.Close()
      FileStreamOut.Dispose()
      FileStreamIn.Dispose()
End Try
End Function

#End If

#End Region ' Encrypt

#Region "Decrypt"

Public Function Decrypt(ByVal ToDecryptData As Byte())
Dim decryptedData As Byte() = Encoding.Unicode.GetBytes(Fout)
Dim MemStream As New MemoryStream()
    algorithm.Key = Key
    algorithm.IV = IV
Try
Dim CryptStream As CryptoStream = New CryptoStream(MemStream, _
                                            algorithm.CreateDecryptor(), CryptoStreamMode.Write)
      CryptStream.Write(ToDecryptData, 0, ToDecryptData.Length)
      CryptStream.Close()
      decryptedData = MemStream.ToArray()
      CryptStream.Dispose()
Return decryptedData
Catch ex As Exception
Return decryptedData
Finally
MemStream.Close()
      MemStream.Dispose()
End Try
End Function

Public Function Decrypt(ByVal ToDecryptText As String, ByVal Sleutel As String) As String
Try
MakeKey(Sleutel)
Dim ToDecryptBytes As Byte() = Convert.FromBase64String(ToDecryptText)
Dim decryptedData As Byte() = Decrypt(ToDecryptBytes)
Return Encoding.Unicode.GetString(decryptedData, 0, decryptedData.Length)
Catch ex As Exception
Return Fout
End Try
End Function

#If Compile Then

Public Function Decrypt(ByVal ToDecryptData As Byte(), ByVal Sleutel As String) As Byte()
    MakeKey(Sleutel)
Return Decrypt(ToDecryptData)
End Function

Public Function Decrypt(ByVal fileIn As String, ByVal fileOut As String, _
ByVal Password As String) As Integer
' '' Return: -1 = OK, 0 = read/write Error, 1 = no FileIn, 2 = user cancelled
Dim i As Integer = Filetest(fileIn, fileOut) > 0
If i > 0 Then Return i
    MakeKey(Password)
Dim FileStreamIn As New FileStream(fileIn, FileMode.Open, FileAccess.Read)
Dim FileStreamOut As New FileStream(fileOut, FileMode.OpenOrCreate, FileAccess.Write)
Try
algorithm.Key = Key
      algorithm.IV = IV
Dim CryptStream As New CryptoStream(FileStreamOut, algorithm.CreateDecryptor(), _
                                          CryptoStreamMode.Write)
Dim bufferLen As Integer = 4096
Dim buffer As Byte() = New Byte(bufferLen - 1) {}
Dim bytesRead As Integer
Do
bytesRead = FileStreamIn.Read(buffer, 0, bufferLen)
        CryptStream.Write(buffer, 0, bytesRead)
Loop While bytesRead <> 0
      CryptStream.Close()
      CryptStream.Dispose()
Return -1
Catch ex As Exception
Return 0
Finally
FileStreamOut.Close()
      FileStreamIn.Close()
      FileStreamOut.Dispose()
      FileStreamIn.Dispose()
End Try
End Function

#End If

#End Region ' Decrypt

End Module