string.asp

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

    objTemp.Charset = "UNICODE"
    objTemp.Open
    For i = 0 To UBound(arr)
        objTemp.WriteText ChrB(arr(i))
    Next
    objTemp.Position = 0
    objTemp.Type = adTypeBinary
    objTemp.Position = 2
    ArrayToBytes = objTemp.Read(-1)
    Set objTemp = Nothing
End Function

Public Function StringChange(ByVal strData, ByVal strSrc, ByVal strDest)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText
    objTemp.Charset = strSrc
    objTemp.Open
    objTemp.WriteText strData
    objTemp.Position = 0
    objTemp.Charset = strDest
    StringChange = objTemp.ReadText(adReadAll)
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' Substring         - 返回字符串中指定位置的子字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'                   - arguments[1] = 初始位置(type: Long)
'                   - arguments[2] = 结束位置(type: Long)
'--------------------------------------------------------------------
Public Function SubString(ByVal strData, ByVal iPos1, ByVal iPos2)
    SubString = Mid(strData, iPos1, iPos2 - iPos1)
End Function

'--------------------------------------------------------------------
' JSEncode          - 转换VBS字符串为JS字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function JSEncode(vtData)
    If IsNull(vtData) Then Exit Function
    Dim ret
    ret = vtData
    ret = Replace(ret, "\", "\\")
    ret = Replace(ret, Chr(8), "\b")
    ret = Replace(ret, Chr(9), "\t")
    ret = Replace(ret, Chr(10), "\n")
    ret = Replace(ret, Chr(12), "\f")
    ret = Replace(ret, Chr(13), "\r")
    ret = Replace(ret, Chr(34), "\""")
    ret = Replace(ret, Chr(39), "\'")
    JSEncode = ret
End Function

'--------------------------------------------------------------------
' JSDecode          - 转换JS字符串为VBS字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function JSDecode(vtData)
    JSDecode = preg_replace2("\\([\\btnfr""'])", "g", "JSChange", vtData)
End Function

Private Function JSChange(match)
    Dim ret
    Select Case match.SubMatches(0)
    Case "\"
        ret = "\"
    Case "b"
        ret = Chr(8)
    Case "t"
        ret = Chr(9)
    Case "n"
        ret = Chr(10)
    Case "f"
        ret = Chr(12)
    Case "r"
        ret = Chr(13)
    Case """"
        ret = Chr(34)
    Case "'"
        ret = Chr(39)
    End Select
    JSChange = ret
End Function

'--------------------------------------------------------------------
' VBSEncode         - 转换一个字符串为能被双引号包含的字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Private Function VBSEncode(ByVal strData)
    Dim ret
    ret = strData
    ret = Replace(ret, """", """""")
    ret = Replace(ret, vbCrLf, """ & vbCrLf & """)
    ret = Replace(ret, vbCr, """ & vbCr & """)
    ret = Replace(ret, vbLf, """ & vbLf & """)
    VBSEncode = ret
End Function

'--------------------------------------------------------------------
' UEncode           - 转换双字节字符为UNICODE的&#x****;表达方式的字符
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function UEncode(ByVal strData)
    Dim ret
    ret = Escape(strData)
    ret = reg_replace("%u([A-Fa-f0-9]{4})", "g", "&#x$1;", ret)
    ret = preg_replace("%([A-Fa-f0-9]{2})", "g", "ChrW(&H$1)", ret)
    UEncode = ret
End Function

'--------------------------------------------------------------------
' UDecode           - 转换UNICODE的&#x****;表达方式的字符为双字节字符
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function UDecode(ByVal strData)
    Dim ret
    ret = strData
    ret = reg_replace("&#x([A-Fa-f0-9]{4});", "g", "%u$1", ret)
    ret = preg_replace("&#([\d]{4,5});", "g", "ChrW($1)", ret)
    ret = UnEscape(ret)
    UDecode = ret
End Function

'--------------------------------------------------------------------
' SafeString        - 转换字符串为SQL字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function SafeString(vtData)
    If IsNull(vtData) Then Exit Function
    Dim ret
    ret = vtData
    ret = Replace(ret, "'", "''")
    ret = Replace(ret, Chr(0), "")
    SafeString = ret
End Function

'--------------------------------------------------------------------
' SafeArray         - 转换字符串数组为SQL字符串数组
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function SafeArray(arr)
    Dim ret, i
    ReDim ret(UBound(arr))
    For i = 0 To UBound(arr)
        ret(i) = "'" & SafeString(arr(i)) & "'"
    Next
    SafeArray = Join(ret, ",")
End Function

'--------------------------------------------------------------------
' ValidEmail        - 检测字符串是否为正确的Email格式
'                   - 返回类型：Boolean
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function ValidEmail(ByVal strData)
    ValidEmail = reg_test("^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$", "", strData)
End Function

'--------------------------------------------------------------------
' ValidMobile       - 检测字符串是否为正确的手机号码格式
'                   - 返回类型：Boolean
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function ValidMobile(ByVal strData)
    ValidMobile = reg_test("^1[35][\d]{9}$", "", strData)
End Function

'--------------------------------------------------------------------
' ValidURL          - 检测字符串是否为正确的URL格式
'                   - 返回类型：Boolean
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function ValidURL(ByVal strData)
    ValidURL = reg_test("^http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?$", "", strData)
End Function

'--------------------------------------------------------------------
' GetRandom         - 获取指定长度的随机字符串
'                   - 返回类型：String
'                   - arguments[0] = 指定长度(type: Long)
'--------------------------------------------------------------------
Public Function GetRandom(ByVal intSize)
    Dim arr, ret, i, l
    ReDim ret(intSize - 1)
    arr = Array _
    ( _
        "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", "0", "1", _
        "2", "3", "4", "5", "6", "7", _
        "8", "9" _
    )
    l = UBound(arr)
    Randomize
    For i = 0 To intSize - 1
        ret(i) = arr(CInt(Rnd * l))
    Next
    GetRandom = Join(ret, "")
    Erase ret
End Function

Public Function GetGUID()    
    Dim obj
    Set obj = Server.CreateObject("Scriptlet.TypeLib")
    GetGUID = obj.GUID
    Set obj = Nothing
End Function

Public Function StringEllipsis(ByVal strData, ByVal intBytes)
    Dim ret, tmp
    tmp = LeftC(strData, intBytes)
    If Len(tmp) = Len(strData) Then
        ret = tmp
    Else
        ret = Replace("$1...", "$1", tmp)
    End If
    StringEllipsis = ret
End Function

Public Function JPEncode(ByVal strData)
    Dim arr, ptr
    Dim ret
    arr = Array(&H30B4, &H30AC, &H30AE, &H30B0, &H30B2, &H30B6, &H30B8, &H30BA, &H30C5, &H30C7, &H30C9, &H30DD, &H30D9, &H30D7, &H30D3, &H30D1, &H30F4, &H30DC, &H30DA, &H30D6, &H30D4, &H30D0, &H30C2, &H30C0, &H30BE, &H30BC)
    ret = strData
    For Each ptr In arr
        ret = Replace(ret, ChrW(ptr), "&#x" & Hex(ptr) & ";")
    Next
    JPEncode = ret
End Function

'格式化字符串中$后的数字为数组中对应的元素
'e.g.
'Response.Write str_format("hello $0, current time: $1", Array("moex", Now()))
Public Function str_format(ByVal strData, arr)
    Dim pos1, pos2
    Dim ret, index
    pos1 = 1
    Do While True
        pos2 = InStr(pos1, strData, "$")
        If pos2 = 0 Then Exit Do
        ret = ret & Mid(strData, pos1, pos2 - pos1)
        index = Mid(strData, pos2 + 1, 1)
        If IsNumeric(index) Then
            ret = ret & arr(index)
        ElseIf index = "$" Then
            ret = ret & "$"
        Else
            ret = ret & Mid(strData, pos2, 2)
        End If
        pos1 = pos2 + 2
    Loop
    ret = ret & Mid(strData, pos1)
    str_format = ret
End Function

Public Function StringToHex(ByVal strData)
    Dim tmp, i
    ReDim tmp(Len(strData) - 1)
    For i = 1 To Len(strData)
        tmp(i - 1) = Hex2(Asc(Mid(strData, i, 1)), 2)
    Next
    StringToHex = Join(tmp, Empty)
End Function

Public Function BinaryToHex(vtData)
    Dim tmp, i
    ReDim tmp(LenB(vtData) - 1)
    For i = 1 To LenB(vtData)
        tmp(i - 1) = Hex2(AscB(MidB(vtData, i, 1)), 2)
    Next
    BinaryToHex = Join(tmp, Empty)
End Function
%>