string.asp

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

<%
'--------------------------------------------------------------------
' string.asp - string functions
'
' Copyright (c) 2006 - 2008 MOEx Group.
'
'
' last update: 2008/06/16
'
'--------------------------------------------------------------------

'--------------------------------------------------------------------
' StrConv           - VB的StrConv实现
'                   - 返回类型：Variant
'                   - arguments[0] = 数据(type: String Or Byte())
'                   - arguments[1] = 转换定义(type: Integer)
'--------------------------------------------------------------------
Public Function StrConv(vtData, ByVal iConv)
    Dim i, k, a, l
    Dim ret, tmp, blnSpace
    Select Case iConv
    Case vbUpperCase
        ret = UCase(vtData)
    Case vbLowerCase
        ret = LCase(vtData)
    Case vbProperCase
        blnSpace = False
        ReDim tmp(Len(vtData) - 1)
        For i = 1 To Len(vtData)
            a = AscW(Mid(vtData, i, 1)) And &HFFFF&
            If isspace(a) Then
                blnSpace = True
            ElseIf blnSpace Then
                If Not isspace(a) Then blnSpace = False
                If islower(a) Then
                    a = a - 32
                End If
            End If
            tmp(i - 1) = ChrW(a)
        Next
        ret = Join(tmp, Empty)
    Case vbWide
        l = Len(vtData)
        ReDim tmp(l - 1)
        For i = 1 To l
            a = AscW(Mid(vtData, i, 1)) And &HFFFF&
            If a = 32 Then
                tmp(i - 1) = ChrW(12288)
            ElseIf a < 128 Then
                tmp(i - 1) = ChrW(a + 65248)
            Else
                tmp(i - 1) = ChrW(a)
            End If
        Next
        ret = Join(tmp, Empty)
    Case vbNarrow
        l = Len(vtData)
        ReDim tmp(l - 1)
        For i = 1 To l
            a = AscW(Mid(vtData, i, 1)) And &HFFFF&
            If a = 12288 Then
                tmp(i - 1) = ChrW(32)
            ElseIf a > 65280 And a < 65375 Then
                tmp(i - 1) = ChrW(a - 65248)
            Else
                tmp(i - 1) = ChrW(a)
            End If
        Next
        ret = Join(tmp, Empty)
    Case vbUnicode
        ret = BytesToString(vtData, LOCAL_CHARSET)
    Case vbFromUnicode
        ret = StringToBytes(vtData, LOCAL_CHARSET)
    End Select
    StrConv = ret
End Function

'--------------------------------------------------------------------
'Hex2               - 整数转指定长度的十六进制字符串，长度不足左补0
'                   - 返回类型：String
'                   - arguments[0] = 整数(type: Long)
'                   - arguments[1] = 长度(type: Integer)
'--------------------------------------------------------------------
Public Function Hex2(ByVal lValue, ByVal iSize)
    Hex2 = LeftFill(Hex(lValue), iSize, "0")
End Function

'--------------------------------------------------------------------
' LeftFill          - 不足指定长度的字符串左补相差个数的重复字符
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'                   - arguments[1] = 指定长度(type: Long)
'                   - arguments[2] = 字符(type: String)
'--------------------------------------------------------------------
Public Function LeftFill(ByVal strData, ByVal intSize, ByVal c)
    Dim intLen
    intLen = Len(strData)
    If intSize > intLen Then
        LeftFill = String(intSize - intLen, c) & strData
    Else
        LeftFill = strData
    End If
End Function

'--------------------------------------------------------------------
' RightFill         - 不足指定长度的字符串右补相差个数的重复字符
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'                   - arguments[1] = 指定长度(type: Long)
'                   - arguments[2] = 字符(type: String)
'--------------------------------------------------------------------
Public Function RightFill(ByVal strData, ByVal intSize, ByVal c)
    Dim intLen
    intLen = Len(strData)
    If intSize > intLen Then
        RightFill = strData & String(intSize - Len(strData), c)
    Else
        RightFill = strData
    End If
End Function

'--------------------------------------------------------------------
' LeftC             - 返回指定长度的从字符串的左边算起的字节
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'                   - arguments[1] = 指定长度(type: Long)
'--------------------------------------------------------------------
Public Function LeftC(ByVal strData, ByVal intSize)
    Dim i, k, l, u
    l = Len(strData)
    k = 0
    For i = 1 To l
        u = AscW(Mid(strData, i, 1)) And &HFFFF&
        k = k + IIf(u < 128, 1, 2)
        If k = intSize Then Exit For
        If k > intSize Then
            i = i - 1
            Exit For
        End If
    Next
    LeftC = Left(strData, i)
End Function

'--------------------------------------------------------------------
' LenC              - 返回指定字符串的字节数
'                   - 返回类型：Long
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function LenC(ByVal strData)
    LenC = LenB(StrConv(strData, vbFromUnicode))
End Function

'--------------------------------------------------------------------
' Base64Encode      - Base64编码字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String Or Byte())
'--------------------------------------------------------------------
Public Function Base64Encode(vtData)
    Dim xmlDoc, xmlNode
    Set xmlDoc = xml.cloneNode(True)
    Set xmlNode = xmlDoc.createElement("temp")
    xmlNode.dataType = "bin.base64"
    If VarType(vtData) = (vbByte Or vbArray) Then
        xmlNode.nodeTypedValue = vtData
    Else
        xmlNode.nodeTypedValue = StringToBytes(vtData, LOCAL_CHARSET)
    End If
    Base64Encode = xmlNode.text
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
End Function

'--------------------------------------------------------------------
' Base64Decode      - Base64解码字符串
'                   - 返回类型：String
'                   - arguments[0] = 字符串(type: String)
'--------------------------------------------------------------------
Public Function Base64Decode(ByVal strData)
    Dim vtData
    vtData = Base64Decode2(strData)
    If VarType(vtData) = (vbByte Or vbArray) Then
        Base64Decode = BytesToString(vtData, LOCAL_CHARSET)
    End If
End Function

Public Function Base64Decode2(ByVal strData)
    On Error Resume Next
    Dim xmlDoc, xmlNode
    Set xmlDoc = xml.cloneNode(True)
    Set xmlNode = xmlDoc.createElement("temp")
    xmlNode.dataType = "bin.base64"
    xmlNode.text = strData
    Base64Decode2 = xmlNode.nodeTypedValue
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    If Err.Number Then Err.Clear
End Function

'--------------------------------------------------------------------
' BytesToString     - 字节数组或字节串转指定字符集的字符串
'                   - 返回类型：String
'                   - arguments[0] = 数据(type: Byte() Or String)
'                   - arguments[1] = 指定字符集(type: String)
'--------------------------------------------------------------------
Public Function BytesToString(vtData, ByVal strCharset)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeBinary
    objTemp.Open
    If VarType(vtData) = vbString Then
        objTemp.Write BinaryToBytes(vtData)
    Else
        objTemp.Write vtData
    End If
    objTemp.Position = 0
    objTemp.Type = adTypeText
    objTemp.Charset = strCharset
    BytesToString = objTemp.ReadText(adReadAll)
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' BinaryToBytes     - 字节串转字节数组
'                   - 返回类型：Byte()
'                   - arguments[0] = 数据(type: String)
'--------------------------------------------------------------------
Public Function BinaryToBytes(vtData)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText
    objTemp.Charset = "UNICODE"
    objTemp.Open
    objTemp.WriteText vtData
    objTemp.Position = 0
    objTemp.Type = adTypeBinary
    objTemp.Position = 2
    BinaryToBytes = objTemp.Read(adReadAll)
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' StringToBytes     - 将指定字符集的字符串转字节数组
'                   - 返回类型：Byte()
'                   - arguments[0] = 字符串(type: String)
'                   - arguments[1] = 指定字符集(type: String)
'--------------------------------------------------------------------
Public Function StringToBytes(ByVal strData, ByVal strCharset)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText
    objTemp.Charset = strCharset
    objTemp.Open
    objTemp.WriteText strData
    objTemp.Position = 0
    objTemp.Type = adTypeBinary
    Select Case UCase(strCharset)
    Case "UNICODE", "UTF-16", "UTF-16BE", "UTF-16LE"
        objTemp.Read 2 '去掉 UNICODE 签名
    Case "UTF-8"
        objTemp.Read 3 '去掉 UTF-8 BOM 签名
    Case Else
    End Select
    StringToBytes = objTemp.Read(adReadAll)
    objTemp.Close
    Set objTemp = Nothing
End Function

Public Function BytesToArray(vtData)
    Dim ret, i
    ReDim ret(LenB(vtData) - 1)
    For i = 1 To LenB(vtData)
        ret(i - 1) = AscB(MidB(vtData, i, 1))
    Next
    BytesToArray = ret
End Function

Public Function BytesToArray2(vtData, ByVal pos1, ByVal pos2)
    Dim ret, i
    ReDim ret(pos2 - pos1)
    For i = pos1 To pos2
        ret(i - pos1) = AscB(MidB(vtData, i, 1))
    Next
    BytesToArray2 = ret
End Function

Private Function ArrayToBytes(arr)
    Dim objTemp, i
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText