北影校花韩一菲全裸出镜写真 »

« 五险一金详解

黑防上的一篇文章中写出来的。代码如下：

Option Explicit

Public Sub MAIN()
    On Error Resume Next
    Dim Aaa As String
    Dim Gx(11) As String '待准备的字符串数组
    Gx(0) = "髙瞻祁见佑厚载翊常由慈和怡伯仲简"
    Gx(1) = "允文遵祖训钦武大君胜顺道宜逢吉师"
    Gx(2) = "尚志公诚秉惟怀敬谊存辅嗣资廉直匡"
    Gx(3) = "赞佐相规约经邦任履亨若依纯一行远"
    Gx(4) = "有子同安睦勤朝在肃恭绍伦敷惠润昭"
    Gx(5) = "孟季均荣显英华蕴盛容宏才升博衍茂"
    Gx(6) = "贤能长可庆睿智实堪宗养性期渊雅寅"
    Gx(7) = "肇泰阳当健观颐寿以弘振举希兼达康"
    Gx(8) = "悦友申宾让承宣奉至平懋进深滋益端"
    Gx(9) = "久镇开方岳扬威谨礼仪刚毅循超卓权"
    Gx(10) = "冲范徵偕旭融谟朗璟逵亶韶愉灏慥令"
    Gx(11) = "佶幼诠勋胤恬珵效回瑝湜源諲皙暐圭"
    Aaa = m_GTSII.GTSII(InputBox("Input Words:", "GTSII", "世界，你好！"), Gx): MsgBox Aaa
    MsgBox m_GTSII.unGTSII(Aaa, Gx)
End Sub

Option Explicit

Public Function GTSII(ByVal Txt As String, ByRef G() As String) As String
    Dim SJn(11) As Integer
    Dim i As Integer, sJs As Integer, eGLen As Integer, gTsX As String
    eGLen = Len(G(0))
    gTsX = CTA(Txt)
    For i = 1 To Len(gTsX)
        sJs = MyRnd(1, eGLen)
        Select Case Mid(gTsX, i, 1)
            Case "0"
                GTSII = GTSII & (Mid(G(0), sJs, 1))
            Case "1"
                GTSII = GTSII & (Mid(G(1), sJs, 1))
            Case "2"
                GTSII = GTSII & (Mid(G(2), sJs, 1))
            Case "3"
                GTSII = GTSII & (Mid(G(3), sJs, 1))
            Case "4"
                GTSII = GTSII & (Mid(G(4), sJs, 1))
            Case "5"
                GTSII = GTSII & (Mid(G(5), sJs, 1))
            Case "6"
                GTSII = GTSII & (Mid(G(6), sJs, 1))
            Case "7"
                GTSII = GTSII & (Mid(G(7), sJs, 1))
            Case "8"
                GTSII = GTSII & (Mid(G(8), sJs, 1))
            Case "9"
                GTSII = GTSII & (Mid(G(9), sJs, 1))
            Case " "
                GTSII = GTSII & (Mid(G(10), sJs, 1))
            Case "-"
                GTSII = GTSII & (Mid(G(11), sJs, 1))
            Case Else
        End Select
    Next
End Function

Public Function unGTSII(ByVal Txt As String, ByRef G() As String)
    On Error Resume Next
    Dim SJn(11) As Integer
    Dim x As Integer, y As Integer, eGLen As Integer, TH As String
    eGLen = Len(G(0))
    unGTSII = Txt
    For x = 0 To 9
        For y = 1 To eGLen
            TH = Mid(G(x), y, 1)
            unGTSII = Replace(unGTSII, TH, CStr(x))
        Next
    Next
    For y = 1 To eGLen
        TH = Mid(G(10), y, 1)
        unGTSII = Replace(unGTSII, TH, " ")
    Next
    For y = 1 To eGLen
        TH = Mid(G(11), y, 1)
        unGTSII = Replace(unGTSII, TH, "-")
    Next
    unGTSII = ATC(unGTSII)
End Function

Public Function CTA(ByVal Txt As String) As String
    On Error Resume Next
    Dim i As Long
    For i = 1 To Len(Txt)
        CTA = CTA + Chr(32) + CStr(Asc(Mid(Txt, i, 1)))
    Next
    CTA = Trim(CTA)
End Function

Public Function ATC(ByVal Txt As String) As String
    On Error Resume Next
    Dim i As Long
    Dim SsZ() As String
    SsZ = Split(Txt, Chr(32))
    For i = 0 To UBound(SsZ)
        ATC = ATC & Chr(CLng(SsZ(i)))
    Next
End Function

Public Function MyRnd(ByVal UpperBound As Integer, ByVal LowerBound As Integer)
    On Error Resume Next
    Randomize
    MyRnd = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
End Function