随机加解密

Private Function encode(ByVal s As String) As String '加密
    If Len(s) = 0 Then Exit Function
    Dim buff() As Byte
    buff = StrConv(s, vbFromUnicode)  'vbFromUnicode  将字符串由 Unicode 转成系统的缺省码页。
    Dim i As Long
    Dim j As Byte
    Dim k As Byte, m As Byte
    Dim mstr As String
If Combo1.Text = "密钥 1" Then
    Open "e:/密钥/密钥 1.txt" For Input As #1 '打开文件用OPEN 语句
    While Not EOF(1) '判断是否到文件尾
    Line Input #1, mstr '从文件读取一行内容到变量 mstr
    Wend
    Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 2" Then
      Open "e:/密钥/密钥 2.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 3" Then
      Open "e:/密钥/密钥 3.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 4" Then
      Open "e:/密钥/密钥 4.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 5" Then
      Open "e:/密钥/密钥 5.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 6" Then
      Open "e:/密钥/密钥 6.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 7" Then
      Open "e:/密钥/密钥 7.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 8" Then
      Open "e:/密钥/密钥 8.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
  End If
    Dim outs As String
    i = UBound(buff) + 1    '返回指定数组维数的最大可用下标
    outs = Space(2 * i)     'space 返回由指定数目的空格组成的字符串。
    Dim temps As String
    For i = 0 To UBound(buff)
        Randomize Time
        j = CByte(5 * (Math.Rnd()) + 0) '最大产生的随机数只能是5，不能再大了,再大的话，就要多用一个字节
        buff(i) = buff(i) Xor j
        k = buff(i) Mod Len(mstr)
        m = buff(i) / Len(mstr)
        m = m * 2 ^ 3 + j
        temps = Mid(mstr, k + 1, 1) + Mid(mstr, m + 1, 1)
        Mid(outs, 2 * i + 1, 2) = temps
     Next
     encode = outs
End Function

Private Function decode(ByVal s As String) As String '解密
    On Error GoTo myerr
    Dim i As Long
    Dim j As Byte
    Dim k As Byte
    Dim m As Byte
    Dim mstr As String
If Combo1.Text = "密钥 1" Then
    Open "e:/密钥/密钥 1.txt" For Input As #1 '打开文件用OPEN 语句
    While Not EOF(1) '判断是否到文件尾
    Line Input #1, mstr '从文件读取一行内容到变量 mstr
    Wend
    Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 2" Then
      Open "e:/密钥/密钥 2.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 3" Then
      Open "e:/密钥/密钥 3.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 4" Then
      Open "e:/密钥/密钥 4.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 5" Then
      Open "e:/密钥/密钥 5.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 6" Then
      Open "e:/密钥/密钥 6.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 7" Then
      Open "e:/密钥/密钥 7.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
 ElseIf Combo1.Text = "密钥 8" Then
      Open "e:/密钥/密钥 8.txt" For Input As #1 '打开文件用OPEN 语句
      While Not EOF(1) '判断是否到文件尾
      Line Input #1, mstr '从文件读取一行内容到变量 mstr
      Wend
      Close #1 '关闭文件
  End If

    Dim t1 As String, t2 As String
    Dim buff() As Byte
    Dim n As Long
    n = 0
    For i = 1 To Len(s) Step 2
        t1 = Mid(s, i, 1)
        t2 = Mid(s, i + 1, 1)
        k = InStr(1, mstr, t1) - 1
        m = InStr(1, mstr, t2) - 1
        j = m / 2 ^ 3
        m = m - j * 2 ^ 3
        ReDim Preserve buff(n)
        buff(n) = j * Len(mstr) + k
        buff(n) = buff(n) Xor m
        n = n + 1
     Next
     decode = StrConv(buff, vbUnicode)
     Exit Function
myerr:
     decode = ""
End Function

 

'加密模块
Private Sub Command1_Click()
 Dim i As Long
 Dim s As String
If RichTextBox1.Text = "" Then
MsgBox ("请输入要加密的内容!!")
Exit Sub
ElseIf Combo1.Text = "密钥 1" Then
   For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
 ElseIf Combo1.Text = "密钥 2" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 3" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 4" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 5" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 6" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 7" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
ElseIf Combo1.Text = "密钥 8" Then
    For i = 1 To 100
        s = encode(RichTextBox1.Text)
              RichTextBox2.Text = s
    Next
End If
End Sub

'解密模块
Private Sub Command2_Click()
Dim i As Long
Dim s As String
If RichTextBox2.Text = "" Then
MsgBox ("请输入要解密的内容!!")
Exit Sub
ElseIf Combo1.Text = "密钥 1" Then
 For i = 1 To 100
        s = decode(RichTextBox2.Text)
           RichTextBox1.Text = s
        Next
  ElseIf Combo1.Text = "密钥 2" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
            RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 3" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
             RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 4" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
            RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 5" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
             RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 6" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
           RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 7" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
              RichTextBox1.Text = s
        Next
ElseIf Combo1.Text = "密钥 8" Then
    For i = 1 To 100
        s = decode(RichTextBox2.Text)
             RichTextBox1.Text = s
        Next
  End If
End Sub

Private Sub Command3_Click()
RichTextBox1.Text = ""
End Sub

Private Sub Command4_Click()
 RichTextBox2.Text = ""
End Sub
'保存密文
Private Sub Command5_Click()
CommonDialog1.ShowSave
RichTextBox2.SaveFile (CommonDialog1.FileName)
End Sub

Private Sub Command6_Click()
End
End Sub

'打开密文
Private Sub Command7_Click()
CommonDialog1.ShowOpen
RichTextBox2.LoadFile (CommonDialog1.FileName)
End Sub
'打开明文
Private Sub Command8_Click()
CommonDialog1.ShowOpen
RichTextBox1.LoadFile (CommonDialog1.FileName)
End Sub
'保存明文
Private Sub Command9_Click()
CommonDialog1.ShowSave
RichTextBox1.SaveFile (CommonDialog1.FileName)
End Sub

Private Sub exit_Click()
End
End Sub

Private Sub openm_Click()
CommonDialog1.ShowOpen
RichTextBox2.LoadFile (CommonDialog1.FileName)
End Sub

Private Sub openw_Click()
CommonDialog1.ShowOpen
RichTextBox1.LoadFile (CommonDialog1.FileName)
End Sub

Private Sub sm_Click()
CommonDialog1.ShowSave
RichTextBox2.SaveFile (CommonDialog1.FileName)
End Sub

Private Sub sw_Click()
CommonDialog1.ShowSave
RichTextBox1.SaveFile (CommonDialog1.FileName)
End Sub