超级菜鸟寻求帮助

Question

'加密
's：被加密字符串
'n1:个位加密字符串
'n2:十位加密字符串
'n3:百位加密字符串
Function EnCrypt(s As String, n1 As String, n2 As String, n3 As String) As String
    Dim a() As String
    
    a = Split(s, " ")
    Dim ret As String
    ret = ""
    For i = LBound(a) To UBound(a)
        Dim i1 As Integer
        Dim i2 As Integer
        Dim i3 As Integer
        
        i1 = CInt(Mid$(a(i), 1, 1))
        i2 = CInt(Mid$(a(i), 2, 1))
        i3 = CInt(Mid$(a(i), 3, 1))
        ret = ret & Mid$(n3, i3 + 1, 1) & Mid$(n2, i2 + 1, 1) & Mid$(n1, i1 + 1, 1) & " "
    Next i
    
    EnCrypt = Trim(ret)
End Function'解密
's：被解密字符串
'n1:个位加密字符串
'n2:十位加密字符串
'n3:百位加密字符串
Function DeCrypt(s As String, n1 As String, n2 As String, n3 As String) As String
    Dim a() As String
    
    a = Split(s, " ")
    Dim ret As String
    ret = ""
    For i = LBound(a) To UBound(a)
        Dim s1 As String
        Dim s2 As String
        Dim s3 As String
        
        s3 = Mid$(a(i), 1, 1)
        s2 = Mid$(a(i), 2, 1)
        s1 = Mid$(a(i), 3, 1)
        ret = ret & InStr(1, n3, s3) - 1 & InStr(1, n2, s2) - 1 & InStr(1, n1, s1) - 1 & " "
    Next i
    
    DeCrypt = Trim(ret)
End Function
Private Sub Form_Load()
    Dim s As String
    s = EnCrypt("000 111 222 333 444", "5432817906", "8764591320", "2348791056")
    s = DeCrypt(s, "5432817906", "8764591320", "2348791056")
End Sub

Answer 1

上面的代码有错误，下面是正确的代码：'加密
's：被加密字符串
'n1:个位加密字符串
'n2:十位加密字符串
'n3:百位加密字符串
Function EnCrypt(s As String, n1 As String, n2 As String, n3 As String) As String
    Dim a() As String
    
    a = Split(s, " ")
    Dim ret As String
    ret = ""
    For i = LBound(a) To UBound(a)
        Dim i1 As Integer
        Dim i2 As Integer
        Dim i3 As Integer
        
        i3 = CInt(Mid$(a(i), 1, 1))
        i2 = CInt(Mid$(a(i), 2, 1))
        i1 = CInt(Mid$(a(i), 3, 1))
        ret = ret & Mid$(n3, i3 + 1, 1) & Mid$(n2, i2 + 1, 1) & Mid$(n1, i1 + 1, 1) & " "
    Next i
    
    EnCrypt = Trim(ret)
End Function'解密
's：被解密字符串
'n1:个位加密字符串
'n2:十位加密字符串
'n3:百位加密字符串
Function DeCrypt(s As String, n1 As String, n2 As String, n3 As String) As String
    Dim a() As String
    
    a = Split(s, " ")
    Dim ret As String
    ret = ""
    For i = LBound(a) To UBound(a)
        Dim s1 As String
        Dim s2 As String
        Dim s3 As String
        
        s3 = Mid$(a(i), 1, 1)
        s2 = Mid$(a(i), 2, 1)
        s1 = Mid$(a(i), 3, 1)
        ret = ret & InStr(1, n3, s3) - 1 & InStr(1, n2, s2) - 1 & InStr(1, n1, s1) - 1 & " "
    Next i
    
    DeCrypt = Trim(ret)
End Function
Private Sub Form_Load()
    Dim s As String
    s = EnCrypt("123 000 222 333 444", "5432817906", "8764591320", "2348791056")
    s = DeCrypt(s, "5432817906", "8764591320", "2348791056")
End Sub

Answer 2

'模块中：
Option ExplicitPublic Type txtKEY
    eKey As Variant
    dKey(9) As Integer
End Type'密匙
Public Function GetKey(ByVal r As Integer) As txtKEY
    Dim i As Integer
    Select Case r
        Case 0: GetKey.eKey = Array(2, 3, 4, 8, 7, 9, 1, 0, 5, 6)
        Case 1: GetKey.eKey = Array(8, 7, 6, 4, 5, 9, 1, 3, 2, 0)
        Case 2: GetKey.eKey = Array(5, 4, 3, 2, 8, 1, 7, 9, 0, 6)
    End Select
    For i = 0 To 9
        GetKey.dKey(CInt(GetKey.eKey(i))) = i
    Next
End Function'加解密
Public Function GetFile(ByVal fName As String, ByVal mfName As String, _
ByVal m As Integer, ByVal bKey As Boolean) As Boolean
    '--------------------------------------------------------
    '函数参数说明：
    'fName       原文件
    'mfName      目标文件
    'm           产生随机序列的参数，加解密必须一致
    'bKey        加密为 bkey=True；解密为 bKey =False
    '---------------------------------------------------------
    
    Dim s As String                           '原文件当前行
    Dim sTmp() As String                      '原文件行的分组数据
    Dim sTemp(4) As String                    '目标文件行的分组数据
    Dim arr As Variant                        '个十百位不同密匙的各种组合
    Dim arrStr As String                      '密匙组合的一种
    Dim k As Variant                          '当前密匙
    Dim rList As Integer                      '定义随机序列
    Dim i As Integer, j As Integer
                   
    arr = Array("012", "021", "102", "120", "201", "210")
    rList = Int(Rnd(-Abs(m)))
    
    Open fName For Input As #1
    Open mfName For Output As #2
    
    While Not EOF(1)
        Line Input #1, s
        sTmp = Split(s, " ")
        '分组处理
        For i = 0 To UBound(sTmp)
            arrStr = arr(Int(6 * Rnd))       '每一组数随机获取一组密匙组合
            '按位加密(解密)
            For j = 1 To Len(sTmp(i))
                If bKey = True Then
                    k = GetKey(Mid(arrStr, j, 1)).eKey     '对应位置的加密密匙
                Else
                    k = GetKey(Mid(arrStr, j, 1)).dKey     '对应位置的解密密匙
                End If
                sTemp(i) = sTemp(i) & Format(k(Mid(sTmp(i), j, 1)))  '加密或者解密
            Next j
        Next
        Print #2, Trim(sTemp(0) & " " & sTemp(1) & " " _
                  & sTemp(2) & " " & sTemp(3) & " " & sTemp(4))
        Erase sTemp
    Wend
    Reset
    
End Function
窗体中：'加密
Private Sub Command2_Click()
    Dim b As Boolean
    b = GetFile(App.Path & "\Test.txt", App.Path & "\Enc.txt", 52, True)
End Sub'解密
Private Sub Command3_Click()
    Dim b As Boolean
    b = GetFile(App.Path & "\Enc.txt", App.Path & "\Dec.txt", 52, False)
End Sub'老师指定的文件
Private Sub Command1_Click()
    
    Dim fName As String
    Dim i As Integer, j As Integer
    Dim sTmp As String
    
    fName = App.Path & "\test.txt"
    Open fName For Output As #1
    For i = 0 To 999
        If j < 5 Then
            sTmp = sTmp & " " & Format(i, "000")
            j = j + 1
        End If
        If j = 5 Then
            Print #1, Trim(sTmp)
            sTmp = vbNullString
            j = 0
        End If
    Next i
    Reset
    
End Sub不知道是否符合要求，反正加解原理就这样，自己完善

Answer 3

我是才学的VB ，这个收藏了，谢谢，小学就学VB ，强！