利用Ascii码 值反回随机字符串--EMail

liujinkui

'Author:  liujinkui
'Date:    2009-08-19
'###############################################################
'Discript: 利用Ascii码 值反回随机字符串
' Diaital() 返回数字
' UppercaseLetters()返回大写字母
'LowercaseLetters() 返回小写字母
'SpecialCharacters() 返回特殊字符
'DecimalPoint() 返回小数点
' MailCharacter()返回@字符
' StrRandomMail(MyString) 返回一个Email地址
'                  MyString 的规则
'                              逗号是分割符
'                              1---- 代表这是一位数字字符
'                              A---- 代表这是一位大写字符
'                              a---- 代表这是一位小写字符
'                              p---- 代表是一位小数点符
'                              m--- 代表是一位@符
'                              s --- 代表是一位特殊字符
'例句:call StrRandomMail("a,A,1,m,a,a,a,a,p,a,a,a")
'###############################################################

Public Function Digital()

        Dim MyValue
        Randomize   ' Initialize random-number generator.
         MyValue=RandomNumber(48,57)
        Digital=chr(MyValue)
End Function

Public Function UppercaseLetters()

        Dim MyValue
        Randomize   ' Initialize random-number generator.
         MyValue=RandomNumber(65,90)
        UppercaseLetters=chr(MyValue)
End Function

Public Function LowercaseLetters()

        Dim MyValue
        Randomize   ' Initialize random-number generator.
         MyValue=RandomNumber(97,122)
        LowercaseLetters=chr(MyValue)
End Function

Public Function SpecialCharacters()

        Dim MyValue,MyCtrol
        Randomize   ' Initialize random-number generator.
        MyCtrol=RandomNumber(1,4)
        Randomize   ' Initialize random-number generator.
        Select Case MyCtrol
                Case 1
                        MyValue=RandomNumber(32,47)
                Case 2
                        MyValue=RandomNumber(58,64)
                Case 3
                        MyValue=RandomNumber(91,96)
                Case 4
                        MyValue=RandomNumber(123,126)
        End Select
        SpecialCharacters=chr(MyValue)
End Function

Public Function DecimalPoint()

        Dim MyValue
         MyValue=46  '  .
        DecimalPoint=chr(MyValue)
End Function

Public Function MailCharacter()

        Dim MyValue
        MyValue=64  '@
        MailCharacter=chr(MyValue)
End Function

Public Function StrRandomMail(MyString)

        Dim str, MyArray, strSum
        strSum=""
        MyArray = Split(MyString, ",", -1, 1)
       
        For i = 0 To UBound(MyArray)
                Select Case MyArray(i)
                        Case "1"
                                str=Digital()
                        Case "A"
                                str=UppercaseLetters()
                        Case "a"
                                str=LowercaseLetters()
                        Case "p"
                                str=DecimalPoint
                        Case "m"
                                str=MailCharacter
                        Case "s"
                                str=SpecialCharacters()
                End Select
                strSum=strSum&str
        Next
        msgbox(strSum)
        'StrRandomMail=strSum
End Function
   
call StrRandomMail("a,A,1,m,a,a,a,a,p,a,a,a")

liujinkui

上面的程序还可以改进，大家讨论一下下。。。