Dim theStr 
         theStr = InputBox("请输入要加密的字串") 
         If theStr <> "" Then 
                   Call InputBox("请复制已经加密好的字串",,Encode(theStr)) 
         End If 
         Function Encode(strPass) 
                   Dim i, theStr, strTmp 
’ for循环得到密码各个字符的ascii值，每位值都在0～9 
                   For i = 1 To Len(strPass) 
                            strTmp = Asc(Mid(strPass, i, 1)) 
                            theStr = theStr & Abs(strTmp) 
                   Next 
                   strPass = theStr 
                   theStr = "" 
’ 如果前面得到的值位数大于16就进入JoinCutStr函数处理，使之小于16 
                   Do While Len(strPass) > 16 
                            strPass = JoinCutStr(strPass) 
                   Loop 
’ 这个for循环处理每个字符，把7、8、9转为C、D、E，其余不变 
                   For i = 1 To Len(strPass) 
                            strTmp = CInt(Mid(strPass, i, 1)) 
                            strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp) 
                            theStr = theStr & strTmp 
                   Next 
                   Encode = theStr 
         End Function 
’ JoinCutStr函数把奇数位和偶数位的ascii相加整除2得到新字符，取值在0～9 
         Function JoinCutStr(str) 
                   Dim i, theStr 
                   For i = 1 To Len(str) 
                            If Len(str) - i = 0 Then Exit For 
                            theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i + 1, 1))) / 2)) 
                            i = i + 1 
                   Next 
                   JoinCutStr = theStr 
         End Function 
’ VB的(a>b)?a:b 
         Function IIf(var, val1, val2) 
                   If var = True Then 
                            IIf = val1 
                    Else 
                            IIf = val2 
                   End If 
         End Function