Module Module1
    Const m_key = "FILEZILLA1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"

   Sub Main()
        Dim InputString As String
        Dim theKey
        Dim quitenc As Boolean
        quitenc = False

        Do Until quitenc '更多.net源代码 来自乐博网lob.cn
            Console.Clear()
            Console.Write("E - Encode" & vbNewLine & "D - Decode")
            theKey = Console.ReadKey(True)
            Select Case theKey.Key
                Case ConsoleKey.E
                    Console.Write(vbNewLine & "String To Encode: ")
                    InputString = Console.ReadLine
                    Console.Write(vbNewLine & "Encoded String: " & fzenc(InputString))
                Case ConsoleKey.D
                    Console.Write(vbNewLine & "String To Decode: ")
                    InputString = Console.ReadLine
                    Console.Write(vbNewLine & "Encoded String: " & fzdec(InputString))
            End Select

            Console.Write(vbNewLine & vbNewLine & "Press Any Key To Finish or X to start again")
            theKey = Console.ReadKey(True)
            If theKey.Key = ConsoleKey.X Then quitenc = False Else quitenc = True
        Loop

    End Sub



    Function fzdec(ByVal encstring As String)
        Dim retlength As String
        Dim length As Integer


        Dim pos As Integer
        Dim m_key_length As Integer
        Dim i As Integer
        Dim ret As String

        ret = ""
        retlength = Len(encstring)

        If (Not (retlength Mod 3) = 0) Then
            Console.Write(vbNewLine & "not a valid encrypted key length" & vbNewLine)
        End If


        m_key_length = Len(m_key)
        length = retlength / 3
        pos = length Mod m_key_length
        i = 1

        Do While i < length + 1
            Dim p1, p2, p3, p4, p5
            p1 = Mid(encstring, 3 * (i - 1) + 1, 3)
            p2 = i + pos
            p3 = p2 Mod m_key_length
            If p3 = 0 Then p3 = 1
            p4 = Asc(Mid(m_key, p3, 1))
            p5 = p1 Xor p4
            ret = ret & Chr(p5)
            i = i + 1
        Loop


        Return ret

    End Function

    Function fzenc(ByVal encstring As String)
        Dim pos As Integer
        Dim m_key_length As Integer
        Dim ret As String
        Dim length As Integer
        Dim i As Integer

        pos = Len(encstring) Mod Len(m_key)
        m_key_length = Len(m_key)
        ret = ""
        length = Len(encstring)
        i = 1

        Do While i < length + 1
            Dim p1, p2, p3, p4, p5
            p1 = Asc(Mid(encstring, i, 1))
            p2 = i + pos
            p3 = p2 Mod m_key_length
            If p3 = 0 Then p3 = 1
            p4 = Asc(Mid(m_key, p3, 1))
            p5 = p1 Xor p4
            ret = ret & padwithzero(p5)
            i = i + 1
        Loop

        Return ret
    End Function

    Function padwithzero(ByVal padstr As String)
        Dim strlen As Integer
        strlen = Len(padstr)
        Dim padstr_ret As String
        padstr_ret = ""
        Do Until strlen = 3
            padstr_ret = "0" & padstr
            strlen = Len(padstr_ret)
        Loop
        Return padstr_ret
    End Function
End Module