強力鎯頭 VB BLOG

如何將ASP中Server.URLEncode編碼後的字串解碼還原(URLdecode)

' ASP 的寫法 , Function 如下:

<%

Dim s

s=server.urlencode("Hi ! 大家好 , 我是Hammer")

Response.write "URL Encode String : " & s & "<br>"

Response.write "URL Decode String : " & AspUrlDecode(s) & "<p>"

s=server.urlencode("強力Power鎯頭Hammer")

Response.write "URL Encode String : " & s & "<br>"

Response.write "URL Decode String : " & AspUrlDecode(s) & "<p>"

s=server.urlencode("Power強力Hammer鎯頭")

Response.write "URL Encode String : " & s & "<br>"

Response.write "URL Decode String : " & AspUrlDecode(s) & "<p>"

s=server.urlencode("強力鎯頭 是 PowerHammer")

Response.write "URL Encode String : " & s & "<br>"

Response.write "URL Decode String : " & AspUrlDecode(s) & "<p>"

s=server.urlencode("PowerHammer 是 強力鎯頭")

Response.write "URL Encode String : " & s & "<br>"

Response.write "URL Decode String : " & AspUrlDecode(s) & "<p>"

Private Function AspUrlDecode(strValue)

Dim varAry, varElement, objStream, lngLoop, Flag

strValue = Replace(strValue, "+", " ")

varAry = Split(strValue, "%")

Flag = varAry(0) = ""

Set objStream = Server.CreateObject("ADODB.Stream")

With objStream

.Type = 2

.Mode = 3

.Open

For Each varElement In varAry

If varElement <> Empty Then

If Len(varElement) >= 2 And Flag Then

.WriteText ChrB(CInt("&H" & Left(varElement, 2)))

For lngLoop = 3 To Len(varElement)

.WriteText ChrB(Asc(Mid(varElement, lngLoop, 1)))

Next

Else

For lngLoop = 1 To Len(varElement)

.WriteText ChrB(Asc(Mid(varElement, lngLoop, 1)))

Next

Flag = True

End If

End If

Next

.WriteText Chr(0)

.Position = 0

AspUrlDecode = Replace(ConvUnicode(.ReadText), Chr(0), "", 1, -1, 0)

On Error Resume Next

.Close

Set objStream = Nothing

End With

End Function

Public Function ConvUnicode(ByVal strData)

Dim rs, stm, bytAry, intLen

If Len(strData & "") > 0 Then

strData = MidB(strData, 1)

intLen = LenB(strData)

Set rs = Server.CreateObject("ADODB.Recordset")

Set stm = Server.CreateObject("ADODB.Stream")

With rs

.Fields.Append "X", 205, intLen

.Open

.AddNew

rs(0).AppendChunk strData & ChrB(0)

.Update

bytAry = rs(0).GetChunk(intLen)

End With

With stm

.Type = 1

.Open

.Write bytAry

.Position = 0

.Type = 2

.Charset = "Big5"

ConvUnicode = .ReadText

End With

End If

On Error Resume Next

stm.Close

Set stm = Nothing

rs.Close

Set rs = Nothing

End Function

%>

================================================================

' VB6 的寫法 , Function 如下:

Private Function URLDecode(strValue As String) As String

Dim bytAry() As Byte

Dim Flag As Boolean

Dim varAry, varElement

Dim lngCnt As Long, lngLoop As Long

ReDim bytAry(1 To 999999) As Byte

strValue = Replace(strValue, "+", " ")

varAry = Split(strValue, "%")

Flag = varAry(0) = ""

lngCnt = 1

If UBound(varAry) > 0 Then

For Each varElement In varAry

If varElement <> Empty Then

If Len(varElement) >= 2 And Flag Then

bytAry(lngCnt) = Val("&H" & Left(varElement, 2))

lngCnt = lngCnt + 1

For lngLoop = 3 To Len(varElement)

bytAry(lngCnt) = Asc(Mid(varElement, lngLoop, 1))

lngCnt = lngCnt + 1

Next

Else

For lngLoop = 1 To Len(varElement)

bytAry(lngCnt) = Asc(Mid(varElement, lngLoop, 1))

lngCnt = lngCnt + 1

Next

Flag = True

End If

End If

Next

ReDim Preserve bytAry(1 To lngCnt - 1)

URLDecode = StrConv(bytAry, vbUnicode)

Erase bytAry

Else

URLDecode = Join(varAry)

End If

End Function

' 程式呼叫 UrlDecode 函數 , 傳入 Server.Encode 後的字串 , 將傳回結果顯示於訊息方塊

MsgBox UrlDecode("%B1j%A4O%EE%CF%C0Y%AA%BAVB%B3%A1%B8%A8")

MsgBox UrlDecode("Hi%7E%7E%A8%FE%A8%FE%7E%7EYa%7E%7E%5E%5F%5E%B4N%C2%E6%A4l%7E%7E881")