formmain.vb

一款给文件加密解密的程序

Public Class FormMain

    Private Sub FormMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "文件保险箱 V1.0"
    End Sub

    'MD5 加密函数 InputString = 输入的字符串; IsMD5_32 = True 32位MD5 IsMD5_32 = False 16位MD5,IsLower 返回的串值中包含的字母是大写还是小写.
    Public Overloads Function Md5Code_B(ByVal InputString As String) As Byte()
        Dim dataToHash As Byte() = (New System.Text.ASCIIEncoding).GetBytes(InputString)
        Md5Code_B = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash)
    End Function

    Public Overloads Function Md5Code_B(ByVal InputByte As Byte()) As Byte()
        Md5Code_B = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(InputByte)
    End Function

    'Base64 加密
    Public Function Base64Code(ByVal InputString As String) As String
        Dim binaryData() As Byte = System.Text.Encoding.Default.GetBytes(InputString)
        Base64Code = System.Convert.ToBase64String(binaryData, 0, binaryData.Length)
    End Function

    'Base64 解密
    Public Function Base64DeCode(ByVal InputString As String) As String
        Dim binaryData As Byte() = Convert.FromBase64String(InputString)
        Base64DeCode = System.Text.Encoding.GetEncoding("gb2312").GetString(binaryData)
    End Function

    Public Function Md5B64(ByVal InputString As String) As String
        Dim dataToHash As Byte() = (New System.Text.ASCIIEncoding).GetBytes(InputString)
        Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash)
        Dim binaryData() As Byte = System.Text.Encoding.Default.GetBytes(InputString)
        Md5B64 = System.Convert.ToBase64String(hashvalue)
    End Function


    Public Enum EnumFileMode
        Binary
        AsciiHex
    End Enum

    'sFile:    ; bFile:    ; sCode:    ; 
    Private Function EnCode(ByVal sFile As String, ByVal pFile As String, ByVal sCode As String, _
                            Optional ByVal CodeMode As EnumFileMode = EnumFileMode.Binary, _
                            Optional ByVal MutiHash As Boolean = False) As Boolean

        Dim oT As Int32
        Dim nT As Int32
        oT = My.Computer.Clock.TickCount
        Dim i As Int64          '循环变量
        Dim x As Byte           '原字节
        Dim p As Byte           '加密后字节
        Dim H_Code As String    '16进制字串

        Dim Md5_Hash(0 To 15) As Byte   '密码的MD5散列

        If Len(sCode) = 0 Then
            MsgBox("密码不能为空.", MsgBoxStyle.OkOnly, "输入错误")
            Exit Function
        End If
        Md5_Hash = Md5Code_B(sCode)    '得到密码的32位MD5

        If MutiHash = True Then    '计算多重HASH
            Dim vi = Len(sCode)
            If vi < 0 Then
                vi = 0
            ElseIf vi > 16 Then
                vi = 16
            End If
            For i = 0 To vi
                Md5_Hash = Md5Code_B(Md5_Hash)
            Next
        End If

        If System.IO.File.Exists(sFile) = False Then
            MsgBox("原文件 [" & sFile & "] 不存在!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Function
        End If
        If System.IO.File.Exists(pFile) = True Then
            Dim v As MsgBoxResult
            v = MsgBox("目标文件 [" & pFile & "] 已存在,是否覆盖?", MsgBoxStyle.YesNo, "操作询问")
            If v = MsgBoxResult.Yes Then
                Kill(pFile)
            Else
                Exit Function
            End If
        End If

        Dim oFile As New System.IO.FileStream(sFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Read)
        Dim cFile As New System.IO.FileStream(pFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
        Dim CP As Double

        i = 0
        Me.ToolStripProgressBarX.Value = 0
        While oFile.Length <> oFile.Position
            x = oFile.ReadByte
            p = x Xor Md5_Hash(i)            '加密字节
            If CodeMode = EnumFileMode.Binary Then
                cFile.WriteByte(p)
            ElseIf CodeMode = EnumFileMode.AsciiHex Then
                H_Code = CStr(Hex(p))        '得到此字节的16进制串
                If Len(H_Code) = 1 Then      '为一位16进制数补0
                    H_Code = "0" & H_Code
                ElseIf Len(H_Code) <> 2 Then
                    MsgBox("16进制数不正确.")
                    Exit Function
                End If
                cFile.Write((New System.Text.ASCIIEncoding).GetBytes(H_Code), 0, 2)
            End If
            i = i + 1
            If i >= 16 Then i = 0

            My.Application.DoEvents()
            '显示进度
            CP = oFile.Position / oFile.Length
            Me.ToolStripStatusLabelX.Text = "正在加密文件...   [" & (CP * 100).ToString("0.00") & "%]"
            Me.ToolStripProgressBarX.Value = CP * 100
        End While
        oFile.Dispose()
        oFile.Close()
        cFile.Dispose()
        cFile.Close()
        nT = My.Computer.Clock.TickCount
        Me.ToolStripStatusLabelX.Text = "完成.   执行时间: " & (nT - oT).ToString() & " mS"
        Me.ToolStripProgressBarX.Value = 100

    End Function

    Private Function DeCode(ByVal sFile As String, ByVal pFile As String, ByVal sCode As String, _
                            Optional ByVal CodeMode As EnumFileMode = EnumFileMode.Binary, _
                            Optional ByVal MutiHash As Boolean = False) As Boolean

        Dim oT As Int32
        Dim nT As Int32
        oT = My.Computer.Clock.TickCount
        Dim i As Int64          '循环变量
        Dim x As Byte           '原字节
        Dim p As Byte           '加密后字节
        Dim H_Code As String    '16进制字串

        Dim Md5_Hash(0 To 15) As Byte   '密码的MD5散列

        If Len(sCode) = 0 Then
            MsgBox("密码不能为空.", MsgBoxStyle.OkOnly, "输入错误")
            Exit Function
        End If
        Md5_Hash = Md5Code_B(sCode)    '得到密码的32位MD5

        If MutiHash = True Then    '计算多重HASH
            Dim vi = Len(sCode)
            If vi < 0 Then
                vi = 0
            ElseIf vi > 16 Then
                vi = 16
            End If
            For i = 0 To vi
                Md5_Hash = Md5Code_B(Md5_Hash)
            Next
        End If

        If System.IO.File.Exists(sFile) = False Then
            MsgBox("原文件 [" & sFile & "] 不存在!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Function
        End If
        If System.IO.File.Exists(pFile) = True Then
            Dim v As MsgBoxResult
            v = MsgBox("目标文件 [" & pFile & "] 已存在,是否覆盖?", MsgBoxStyle.YesNo, "操作询问")
            If v = MsgBoxResult.Yes Then
                Kill(pFile)
            Else
                Exit Function
            End If
        End If

        Dim oFile As New System.IO.FileStream(sFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Read)
        Dim cFile As New System.IO.FileStream(pFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
        Dim xReadBuff(0 To 1) As Byte
        Dim CP As Double

        i = 0
        While oFile.Length <> oFile.Position
            If CodeMode = EnumFileMode.Binary Then
                x = oFile.ReadByte
            ElseIf CodeMode = EnumFileMode.AsciiHex Then
                x = oFile.Read(xReadBuff, 0, 2)
                H_Code = Chr(xReadBuff(0)) & Chr(xReadBuff(1))     '得到此字节的16进制串
                'If MsgBox(H_Code, MsgBoxStyle.OkCancel, CStr(oFile.Position) & "/" & CStr(oFile.Length)) = MsgBoxResult.Cancel Then
                '    Exit While
                'End If
                x = Val("&H" & H_Code)
            End If
            p = x Xor Md5_Hash(i)            '加密字节
            cFile.WriteByte(p)
            i = i + 1
            If i >= 16 Then i = 0

            My.Application.DoEvents()
            '显示进度
            CP = oFile.Position / oFile.Length
            Me.ToolStripStatusLabelX.Text = "正在解密文件...   [" & (CP * 100).ToString("0.00") & "%]"
            Me.ToolStripProgressBarX.Value = CP * 100
        End While
        oFile.Dispose()
        oFile.Close()
        cFile.Dispose()
        cFile.Close()
        nT = My.Computer.Clock.TickCount
        Me.ToolStripStatusLabelX.Text = "完成.   执行时间: " & (nT - oT).ToString() & " mS"
        Me.ToolStripProgressBarX.Value = 100
    End Function


    Private Sub ButtonEnCode_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonEnCode.Click
        MsgBox("准备加密文件")
        Dim FileModeX As EnumFileMode
        If Me.TextBoxLoad.Text = "" Or Me.TextBoxCreate.Text = "" Then
            MsgBox("请填写正确的原文与目标路径!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Sub
        End If
        If Me.TextBoxPassword.Text <> Me.TextBoxPasswordC.Text Then
            MsgBox("2次密码不一致!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Sub
        End If
        If Me.CheckBoxCreateAsciiCoding.Checked = True Then
            FileModeX = EnumFileMode.AsciiHex
        Else
            FileModeX = EnumFileMode.Binary
        End If
        Call EnCode(Me.TextBoxLoad.Text, Me.TextBoxCreate.Text, Me.TextBoxPassword.Text, FileModeX, Me.CheckBoxMutiHash.Checked)
        MsgBox("完成")
    End Sub

    Private Sub ButtonDeCode_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonDeCode.Click
        MsgBox("准备解密文件")
        Dim FileModeX As EnumFileMode
        If Me.TextBoxLoad.Text = "" Or Me.TextBoxCreate.Text = "" Then
            MsgBox("请填写正确的原文与目标路径!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Sub
        End If
        If Me.CheckBoxCreateAsciiCoding.Checked = True Then
            FileModeX = EnumFileMode.AsciiHex
        Else
            FileModeX = EnumFileMode.Binary
        End If
        Call DeCode(Me.TextBoxLoad.Text, Me.TextBoxCreate.Text, Me.TextBoxPassword.Text, FileModeX, Me.CheckBoxMutiHash.Checked)
        MsgBox("完成")
    End Sub

    Private Sub ButtonLoadFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonLoadFile.Click
        Me.OpenFileDialogX.ShowDialog()
        Me.TextBoxLoad.Text = Me.OpenFileDialogX.FileName
    End Sub

    Private Sub ButtonViewPassword_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonViewPassword.Click
        If Me.TextBoxPassword.Text <> Me.TextBoxPasswordC.Text Then
            MsgBox("2次密码不一致!", MsgBoxStyle.OkOnly, "输入错误")
            Exit Sub
        End If
        MsgBox(Me.TextBoxPassword.Text, MsgBoxStyle.OkOnly, "核对密码")
    End Sub

    Private Sub ButtonExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonExit.Click
        End
    End Sub

    Private Sub ButtonAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonAbout.Click
        FormAbout.ShowDialog()
    End Sub
End Class