Sub main()
Dim Data1 As String, N1 As String, X1 As String, N2 As String
Dim I As Long, S As Long, D As Long
    Open App.Path & "\Input.txt" For Input As #1 '开输入文字档
    Open App.Path & "\Output.txt" For Output As #2 '开输出文字档
        Input #1, Data1 '读输入文字档到 Data1变数中
            Data1 = UCase(Data1) '将变数中的英文强制转换为大写
            R = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j") '编码的阵列 如R(0)=a
            
            I = 1
            
            Do
                N1 = Data1: X1 = X1 & Mid(Data1, I, 1)
                If N1 = X1 Then: S = I: Exit Do
                I = I + 1
            Loop Until S < 0 '这个回圈用Len代替即可...目的在测出字串的字数
            
            D = S '将字串长度丢给D
            For I = 1 To S  '此回圈在做排除空白键的动作 空白键ASCII 为32
                If Asc(Mid(Data1, I, 1)) = 32 Then
                    D = D - 1
                End If
            Next I
                            
            For I = 1 To S '开始在做加密的动作
                If Asc(Mid(Data1, I, 1)) = 32 Then '判断是否为空白键 是的话则输入空白键
                    N2 = N2 & " "
                Else
                    N2 = N2 & Asc(Mid(Data1, I, 1)) + D Mod 10
                   '撷取字串转换ASCII+偏移量(字串长度mod10)
                End If
            Next I
        
            N1 = "": X1 = "": I = 1: Data = "**" '该题编码规则开头为两个** 
            
            Do
                N1 = N2: X1 = X1 & Mid(N2, I, 1) '这个部分用VB的F8单部执行就懂了
                If Asc(Mid(N2, I, 1)) = 32 Then '如字串中的空白键输出为*
                    Data = Data & "*"
                Else
                    Data = Data & R(Val(Mid(N2, I, 1))) '转化R阵列的值
                End If
                If N1 = X1 Then: Exit Do '长度相同跳出回圈
                I = I + 1
            Loop Until S < 0
            
            I = 1: X1 = "": N2 = ""
            Do
                N1 = D: X1 = X1 & Mid(D, I, 1) '这个部分用VB的F8单部执行就懂了
                N2 = N2 & R(Mid(D, I, 1)) '将偏移量转化为R阵列的值
                If N1 = X1 Then: S = I: Exit Do '长度相同跳出回圈
                I = I + 1
            Loop Until S < 0
            
            Data = Data & "#" & N2 & "***" '编码的资料尾端加上#偏移量###
            
            Print #2, Data
        Close #1
        Close #2
End Sub

Private Sub CommandButton1_Click()
Dim myFile, myID, myPw, addPw(), cc As Integer, adPw, secPw(), myInputLen, N1, N2, N3, N4, myinput(), mySec
addPw = Array("0*", "1(", "1)", "1_", "1+", "1c", "1d", "1e", "1f", "1|", "1_", "1=", "1\", "1<", "1>", "1/", "1J", "1P", "1Q", "1R", "1W", "1X", "1Y", "1Z", "1S", "1T", "1U", "1V", "1a", "1b", "1h", "1i", "1j", "1k", "1l", "1~", "1!", "1@", "1#", "1$", "1%", "1^", "0*", "0(", "0)", "0_", "0+", "0c", "0d", "0e", "0f", "0|", "0_", "0=", "0\", "0<", "0>", "0/", "0J", "0P", "0Q", "0R", "0W", "0X", "0Y", "0Z", "0S", "0T", "0U", "0V", "0a", "0b", "0h", "0i", "0j", "0k", "0l", "0~", "0!", "0@", "0#", "0$", "0%", "0^")
myinput = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
'求阵列变数的数量
mySec = Second(Now())
a = UBound(myinput())
b = UBound(addPw())
N1 = Range("a1").Value
myInputLen = Len(N1)
For i = 1 To myInputLen
    N2 = Mid(N1, i, 1): j = 0
    Do Until j = b
    If N2 = myinput(j) Then N3 = N3 & Format(j, "00"): N4 = N4 & addPw((j + Right(mySec, 1))): Exit Do Else j = j + 1
    Loop
    Range("a2").Value = N3
Next

    Range("a2").Value = N3
    Range("a3").Value = N4 & addPw(Right(mySec, 1))

    
End Sub


Private Sub CommandButton2_Click()
Dim myFile, myID, myPw, addPw(), cc As Integer, adPw, secPw(), myInputLen, N1, N2, N3, N4, myinput(), mySec
addPw = Array("0*", "1(", "1)", "1_", "1+", "1c", "1d", "1e", "1f", "1|", "1_", "1=", "1\", "1<", "1>", "1/", "1J", "1P", "1Q", "1R", "1W", "1X", "1Y", "1Z", "1S", "1T", "1U", "1V", "1a", "1b", "1h", "1i", "1j", "1k", "1l", "1~", "1!", "1@", "1#", "1$", "1%", "1^", "0*", "0(", "0)", "0_", "0+", "0c", "0d", "0e", "0f", "0|", "0_", "0=", "0\", "0<", "0>", "0/", "0J", "0P", "0Q", "0R", "0W", "0X", "0Y", "0Z", "0S", "0T", "0U", "0V", "0a", "0b", "0h", "0i", "0j", "0k", "0l", "0~", "0!", "0@", "0#", "0$", "0%", "0^")
myinput = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
'求阵列变数的数量
mySec = Second(Now())
a = UBound(myinput())
b = UBound(addPw())
'解密
N1 = Range("a3").Value
myInputLen = Len(N1) - 2
Debug.Print "myinputlen:" & myInputLen
mySec = Right(N1, 2): Debug.Print mySec: j = 0
Do Until mySec < b
    If mySec = addPw(j) Then mySec = j: Exit Do Else j = j + 1
Loop
Debug.Print mySec
For i = 1 To myInputLen Step 2
    N2 = Mid(N1, i, 2): j = 0
    Do Until j = b
        If N2 = addPw(j) Then j = j - mySec + 1: N3 = N3 & j: Exit Do Else j = j + 1
    Loop
Next
Range("a4").Value = N3
End Sub