<%
'///////////////////////////////////////////////////////////////////////////////
'//              UC-Client For ASP
'// 作    者:    舞者/LOVE
'// 技术支持:    QQ:48673641
'// 官方网站:    www.a8kk.com
'// 程序名称:    UC-Client For ASP
'// 单元名称:    php_base64.asp
'// 开始时间:    2010.01.05
'// 备    注:    ASP版Base64编码，用于UCenter整合
'///////////////////////////////////////////////////////////////////////////////

Const BASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Public Function php_Base64Encode(ByVal ByteArr)
    Dim lnPosition, lsResult, lsGroupBinary, lsGroup64
	Dim Char1,  Char2, Char3, Char4
    Dim Byte1, Byte2, Byte3
    Dim SaveBits1, SaveBits2
    Dim M4, len1, len2, i
    len1 = UBound(ByteArr)+1
    If len1 < 1 Then
        php_Base64Encode = ""
        Exit Function
    End If
    M4 = len1 Mod 3
    If M4 > 0 Then
    	Redim Preserve ByteArr(len1+(3 - M4)-1)
    	For i=len1 To UBound(ByteArr)
    		ByteArr(i) = 0
    	Next
   	End If
    If M4 > 0 Then
        len1 = len1 + (3 - M4)
        len2 = len1 - 3
    Else
        len2 = len1
    End If
    lsResult = ""
    For lnPosition = 0 To len2-1 Step 3
        Byte1 = ByteArr(lnPosition): SaveBits1 = Byte1 And 3
        Byte2 = ByteArr(lnPosition+1): SaveBits2 = Byte2 And 15
        Byte3 = ByteArr(lnPosition+2)
        Char1 = Mid(BASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
        Char2 = Mid(BASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
        Char3 = Mid(BASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
        Char4 = Mid(BASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
        lsResult = lsResult & (Char1 & Char2 & Char3 & Char4)
    Next
    If M4 > 0 Then
        Byte1 = ByteArr(len2): SaveBits1 = Byte1 And 3
        Byte2 = ByteArr(len2+1): SaveBits2 = Byte2 And 15
        Byte3 = ByteArr(len2+2)
        Char1 = Mid(BASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
        Char2 = Mid(BASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
        Char3 = Mid(BASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
        If M4 = 1 Then
            lsResult = lsResult & (Char1 & Char2 & Chr(61) & Chr(61))
        Else
            lsResult = lsResult & (Char1 & Char2 & Char3 & Chr(61))
        End If
    End If
    php_Base64Encode = lsResult
End Function


Public Function php_Base64Decode(ByVal asContent)
    While Len(asContent) Mod 4 <> 0
        asContent = asContent & "="
    Wend
    Dim lsResult()
    Dim lnPosition
    Dim lsGroup64, lsGroupBinary
    Dim Char1, Char2, Char3, Char4
    Dim Byte1, Byte2, Byte3
    Dim M4, len1, len2
    Dim iPos
    len1 = Len(asContent)
    M4 = len1 Mod 4
    If len1 < 1 Or M4 > 0 Then
        php_Base64Decode = ""
        Exit Function
    End If
    If Mid(asContent, len1, 1) = Chr(61) Then M4 = 3
    If Mid(asContent, len1 - 1, 1) = Chr(61) Then M4 = 2
    If M4 = 0 Then
        len2 = len1
    Else
        len2 = len1 - 4
    End If
    iPos = 0
    Redim lsResult(((Len(asContent) \ 4)-1)*3+10)
    For lnPosition = 1 To len2 Step 4
        lsGroup64 = Mid(asContent, lnPosition, 4)
        Char1 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 1, 1)) - 1
        Char2 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 2, 1)) - 1
        Char3 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 3, 1)) - 1
        Char4 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 4, 1)) - 1
        Byte1 = ((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF
        Byte2 = ((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF
        Byte3 = (((Char3 And 3) * 64) And &HFF) Or (Char4 And 63)
        lsResult(iPos) = Byte1 : iPos = iPos+1
        lsResult(iPos) = Byte2 : iPos = iPos+1
        lsResult(iPos) = Byte3 : iPos = iPos+1
    Next
    If M4 > 0 Then
        lsGroup64 = Mid(asContent, len2 + 1, M4) & Chr(65)
        If M4 = 2 Then lsGroup64 = lsGroup64 & Chr(65)
        Char1 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 1, 1)) - 1
        Char2 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 2, 1)) - 1
        Char3 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 3, 1)) - 1
        Char4 = InStr(BASE_64_CHARACTERS, Mid(lsGroup64, 4, 1)) - 1
        Byte1 = ((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF
        Byte2 = ((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF
        Byte3 = (((Char3 And 3) * 64) And &HFF) Or (Char4 And 63)
        If M4 = 2 Then
            lsResult(iPos) = Byte1 : iPos = iPos+1
        ElseIf M4 = 3 Then
            lsResult(iPos) = Byte1 : iPos = iPos+1
            lsResult(iPos) = Byte2 : iPos = iPos+1
        End If
    End If
    Redim Preserve lsResult(iPos-1)
    php_Base64Decode = lsResult
End Function

Private Function strUnicodeLen(ByVal asContents)
    Dim asContents1
    Dim len1
    Dim k
    Dim i
    Dim asc1
    
    asContents1 = "a" & asContents
    len1 = Len(asContents1)
    k = 0
    For i = 1 To len1
        asc1 = Asc(Mid(asContents1, i, 1))
        If asc1 < 0 Then asc1 = 65536 + asc1
        If asc1 > 255 Then
            k = k + 2
            Else
            k = k + 1
        End If
    Next
    strUnicodeLen = k - 1
End Function

Private Function strUnicode2Ansi(ByVal asContents)
    Dim len1, i, VarChar, varAsc
    Dim varHex, varlow, varhigh
    strUnicode2Ansi = ""
    len1 = Len(asContents)
    For i = 1 To len1
        VarChar = Mid(asContents, i, 1)
        varAsc = Asc(VarChar)
        If varAsc < 0 Then varAsc = varAsc + 65536
        If varAsc > 255 Then
            varHex = Hex(varAsc)
            varlow = Left(varHex, 2)
            varhigh = Right(varHex, 2)
            strUnicode2Ansi = strUnicode2Ansi & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
        Else
            strUnicode2Ansi = strUnicode2Ansi & ChrB(varAsc)
        End If
    Next
End Function

Private Function strAnsi2Unicode(asContents)
    Dim len1, i, VarChar, varAsc
    strAnsi2Unicode = ""
    len1 = LenB(asContents)
    If len1 = 0 Then Exit Function
    For i = 1 To len1
        VarChar = MidB(asContents, i, 1)
        varAsc = AscB(VarChar)
        If varAsc > 127 Then
            strAnsi2Unicode = strAnsi2Unicode & Chr(AscW(MidB(asContents, i + 1, 1) & VarChar))
            i = i + 1
        Else
            strAnsi2Unicode = strAnsi2Unicode & Chr(varAsc)
        End If
    Next
End Function
%>
