ab.com コミュニティ

' 1文字を対応する16進数の数に変換
Function HexChar(c As Byte) As Long
	If c >= &H30 And c <= &H39 Then
		HexChar = c - &H30
	ElseIf c >= &H41 And c <= &H46 Then
		HexChar = c - &H37
	ElseIf c >= &H61 And c <= &H66 Then
		HexChar = c - &H57
	Else
		HexChar = -1
	End If
End Function

' URLデコード（シンプル）
Function URLdecodeSimple(s As String) As String
	Dim i As Long, len As Long
	len = Len(s)
	
	i = 0
	While i < len
		If s = &H25 Then
			' 最後の２文字の場合は対象外
			If i < len - 1 Then
				' 16進数から数値に変換
				URLdecodeSimple = URLdecodeSimple + Chr$(Val("&H" + Mid$(s, i + 2, 2)))
				i = i + 3
				Continue
			End If
		End If
		
		URLdecodeSimple = URLdecodeSimple + Chr$(s)
		i = i + 1
	Wend
End Function

' URLデコード（高速。上のものより約4倍速くなった）
Function URLdecode(s As String) As String
	Dim i As Long, cursor As Long, len As Long
	Dim c1 As Long, c2 As Long
	len = Len(s)
	URLdecode = ZeroString(len)
	cursor = 0
	
	i = 0
	While i < len
		If s = &H25 Then
			' 最後の２文字の場合は対象外
			If i < len - 1 Then 
				' 16進数から数値に変換
				c1 = HexChar(s[i + 1])
				c2 = HexChar(s[i + 2])
				If c1 <> -1 And c2 <> -1 Then
					URLdecode[cursor] = (c1 << 4) Or c2
					i = i + 3
					cursor = cursor + 1
					Continue
				End If
			End If
		End If
		
		URLdecode[cursor] = s
		i = i + 1
		cursor = cursor + 1
	Wend

	URLdecode = MakeStr(URLdecode)
End Function

以前どこかに投稿されていたような気がしたのですが、見当たらなかったので作りました。

2つの関数を書きました。
1つ目は説明のために書いた分かりやすいコードですが、遅いです。
2つ目は高速化されたものです。

[hide][code]' 1文字を対応する16進数の数に変換
Function HexChar(c As Byte) As Long
If c >= &H30 And c <= &H39 Then
HexChar = c - &H30
ElseIf c >= &H41 And c <= &H46 Then
HexChar = c - &H37
ElseIf c >= &H61 And c <= &H66 Then
HexChar = c - &H57
Else
HexChar = -1
End If
End Function

' URLデコード（シンプル）
Function URLdecodeSimple(s As String) As String
Dim i As Long, len As Long
len = Len(s)

i = 0
While i < len
If s[i] = &H25 Then
' 最後の２文字の場合は対象外
If i < len - 1 Then
' 16進数から数値に変換
URLdecodeSimple = URLdecodeSimple + Chr$(Val("&H" + Mid$(s, i + 2, 2)))
i = i + 3
Continue
End If
End If

URLdecodeSimple = URLdecodeSimple + Chr$(s[i])
i = i + 1
Wend
End Function

' URLデコード（高速。上のものより約4倍速くなった）
Function URLdecode(s As String) As String
Dim i As Long, cursor As Long, len As Long
Dim c1 As Long, c2 As Long
len = Len(s)
URLdecode = ZeroString(len)
cursor = 0

i = 0
While i < len
If s[i] = &H25 Then
' 最後の２文字の場合は対象外
If i < len - 1 Then
' 16進数から数値に変換
c1 = HexChar(s[i + 1])
c2 = HexChar(s[i + 2])
If c1 <> -1 And c2 <> -1 Then
URLdecode[cursor] = (c1 << 4) Or c2
i = i + 3
cursor = cursor + 1
Continue
End If
End If
End If

URLdecode[cursor] = s[i]
i = i + 1
cursor = cursor + 1
Wend

URLdecode = MakeStr(URLdecode)
End Function[/code][/hide]