前の記事
ホームに戻る
2007-11-03 Excel VBAで実体参照のエンコードとデコード
Excel VBAでHTMLの実体参照をエンコード・デコードするコードを作りました。コードそのものはVB6.0処理系汎用であり，Excel VBA以外でも使えると思います。
あらまし
「HTMLの実体参照」とは，HTMLのメタ文字をエスケープするための記述方法です。メタ文字とは，「タグ」を書くときに使う文字です（正確にはちょっと違うけど）。たとえば「<>」を書きたいときは，「< > 」と書かなければいけません。「<>」はHTMLのメタ文字なので，これらを直接，書いてしまうと「タグ」と区別がつかなくなってしまうのです。
Excelで実体参照の混ざった文字列を扱うことは，あまりないと思いますが，あまりないがために必要に迫られたとき困るのです。
動作概要
- 実体参照を解決するクラスモジュール（HTMLEntity）を作る
- 「実体参照」と「文字」の対応表を作ることで，双方を変換できるようにする
- 実体参照のパターン抽出には正規表現（Scripting.Regexオブジェクト）を使う
仕様
- エンコード対象の文字は「&<>"」のみ
- デコードは文字実体参照と数値文字参照（10進と16進）に対応
- 誤記により実体参照の末尾の「;（セミコロン）」が存在しなかった場合も，なるべくデコードする
- 対応する文字実体参照は「ISO 8859-1」「一般記号，数学記号，ギリシア文字」「マーク付け記号，国際化文字」だが，デコードした結果のすべての文字コードをExcelで表示できるとは限らない
注意事項
- このコードは無保証です
- 細かな挙動は不明です。たとえば「巨大な文字列に適用した場合」「マッチ数が極端に多い場合」にどんな挙動をするのか明らかではありません。またエンコード・デコードの正当性（本当に正しいのかどうか）は十分に検証しておりません
- このコードはオブジェクト初期化時の計算コストが高いです。一度，生成したオブジェクトはなるべく使い回すようにしてください。とくにループの内部で何度もオブジェクトを生成してはいけません。スループット（処理効率）が低下します
コード（クラスモジュールHTMLEntity）
' require VBScript.RegExp, Scripting.Dictionary
Option Explicit
Private m_regex_encode As Object ' VBScript.RegExp
Private m_regex_decode As Object ' VBScript.RegExp
Private m_regex_decodehex As Object ' VBScript.RegExp
Private m_regex_decodedec As Object ' VBScript.RegExp
Private m_entity2char As Object ' Scripting.Dictionary
Private m_char2entity As Object ' Scripting.Dictionary
Private Function RegExp(pattern As String, Optional g As Boolean = False, _
Optional i As Boolean = False) As Object
Set RegExp = CreateObject("VBScript.RegExp")
With RegExp
.pattern = pattern
.Global = g
.ignorecase = i
End With
End Function
Private Sub Class_Initialize()
Dim t As String
Dim m As Object ' match
Dim name As String
Dim value As String
Set m_regex_encode = RegExp("([""&<>])", g:=True)
Set m_regex_decode = RegExp("&([\w#][\w\d]*);?", g:=True)
Set m_regex_decodehex = RegExp("#[xX]([0-9a-fA-F]{1,4})")
Set m_regex_decodedec = RegExp("#(\d{1,5})")
Set m_entity2char = CreateObject("Scripting.Dictionary")
Set m_char2entity = CreateObject("Scripting.Dictionary")
' ISO 8859-1
t = "" _
& "nbsp 160 iexcl 161 cent 162 pound 163 curren 164 " _
& "yen 165 brvbar 166 sect 167 uml 168 copy 169 " _
& "ordf 170 laquo 171 not 172 shy 173 reg 174 " _
& "macr 175 deg 176 plusmn 177 sup2 178 sup3 179 " _
& "acute 180 micro 181 para 182 middot 183 cedil 184 " _
& "sup1 185 ordm 186 raquo 187 frac14 188 frac12 189 " _
& "frac34 190 iquest 191 Agrave 192 Aacute 193 Acirc 194 " _
& "Atilde 195 Auml 196 Aring 197 AElig 198 Ccedil 199 " _
& "Egrave 200 Eacute 201 Ecirc 202 Euml 203 Igrave 204 " _
& "Iacute 205 Icirc 206 Iuml 207 ETH 208 Ntilde 209 " _
& "Ograve 210 Oacute 211 Ocirc 212 Otilde 213 Ouml 214 " _
& "times 215 Oslash 216 Ugrave 217 Uacute 218 Ucirc 219 " _
& "Uuml 220 Yacute 221 THORN 222 szlig 223 agrave 224 " _
& "aacute 225 acirc 226 atilde 227 auml 228 aring 229 " _
& "aelig 230 ccedil 231 egrave 232 eacute 233 ecirc 234 " _
& "euml 235 igrave 236 iacute 237 icirc 238 iuml 239 " _
& "eth 240 ntilde 241 ograve 242 oacute 243 ocirc 244 " _
& "otilde 245 ouml 246 divide 247 oslash 248 ugrave 249 " _
& "uacute 250 ucirc 251 uuml 252 yacute 253 thorn 254 " _
& "yuml 255"
' Mathematical, Greek and Symbolic (1/2)
t = t & " " _
& "fnof 402 Alpha 913 Beta 914 Gamma 915 " _
& "Delta 916 Epsilon 917 Zeta 918 Eta 919 Theta 920 " _
& "Iota 921 Kappa 922 Lambda 923 Mu 924 Nu 925 " _
& "Xi 926 Omicron 927 Pi 928 Rho 929 Sigma 931 " _
& "Tau 932 Upsilon 933 Phi 934 Chi 935 Psi 936 " _
& "Omega 937 alpha 945 beta 946 gamma 947 delta 948 " _
& "epsilon 949 zeta 950 eta 951 theta 952 iota 953 " _
& "kappa 954 lambda 955 mu 956 nu 957 xi 958 " _
& "omicron 959 pi 960 rho 961 sigmaf 962 sigma 963 " _
& "tau 964 upsilon 965 phi 966 chi 967 psi 968 " _
& "omega 969 thetasym 977 upsih 978 piv 982 bull 8226 " _
& "hellip 8230 prime 8242 Prime 8243 oline 8254 frasl 8260 " _
& "weierp 8472 image 8465 real 8476 trade 8482 alefsym 8501 " _
& "larr 8592 uarr 8593 rarr 8594 darr 8595 harr 8596 " _
& "crarr 8629 lArr 8656 uArr 8657 rArr 8658 dArr 8659 " _
& "hArr 8660 forall 8704 part 8706 exist 8707 empty 8709 " _
& "nabla 8711 isin 8712 notin 8713 ni 8715 prod 8719 " _
& "sum 8721 minus 8722 lowast 8727 radic 8730 prop 8733 " _
& "infin 8734 ang 8736 and 8743 or 8744 cap 8745 " _
& "cup 8746 int 8747 there4 8756 sim 8764 cong 8773 " _
& "asymp 8776 ne 8800 equiv 8801 le 8804 ge 8805 " _
& "sub 8834 sup 8835 nsub 8836 sube 8838 supe 8839 " _
& "oplus 8853 otimes 8855 perp 8869 sdot 8901 lceil 8968 "
' Mathematical, Greek and Symbolic (2/2)
t = t & " " _
& "loz 9674 spades 9824 clubs 9827 hearts 9829 diams 9830 " _
& "rceil 8969 lfloor 8970 rfloor 8971 lang 9001 rang 9002 "
' Special
t = t & " " _
& "quot 34 amp 38 lt 60 gt 62 OElig 338 " _
& "oelig 339 Scaron 352 scaron 353 Yuml 376 circ 710 " _
& "tilde 732 ensp 8194 emsp 8195 thinsp 8201 zwnj 8204 " _
& "zwj 8205 lrm 8206 rlm 8207 ndash 8211 mdash 8212 " _
& "lsquo 8216 rsquo 8217 sbquo 8218 ldquo 8220 rdquo 8221 " _
& "bdquo 8222 dagger 8224 Dagger 8225 permil 8240 lsaquo 8249 " _
& "rsaquo 8250 euro 8364"
For Each m In RegExp("([\w][\w\d]*)\s(\d+)\s?", g:=True).Execute(t)
name = m.submatches(0)
value = ChrW(m.submatches(1))
m_entity2char.Add name, value
m_char2entity.Add value, name
Next
End Sub
Public Function encode(s As String) As String
Dim p As Integer
Dim str As String
Dim m As Object ' match
p = 0
str = ""
For Each m In m_regex_encode.Execute(s)
If p < m.firstindex Then
str = str & Mid(s, p + 1, m.firstindex - p)
End If
str = str & "&" & m_char2entity.Item(m.submatches(0)) & ";"
p = m.firstindex + m.Length
Next
str = str & Mid(s, p + 1)
encode = str
End Function
Public Function decode(s As String) As String
Dim p As Integer
Dim str As String
Dim m As Object ' match
Dim c As String
p = 0
str = ""
For Each m In m_regex_decode.Execute(s)
c = m.submatches(0)
If p < m.firstindex Then
' 実体参照が現れる位置までの文字列をコピーする
str = str & Mid(s, p + 1, m.firstindex - p)
End If
If m_entity2char.Exists(c) Then
' 文字実体参照
str = str & m_entity2char.Item(c)
Else
With m_regex_decodehex.Execute(c)
If .Count Then
' 数値文字参照16進
str = str & Chr(val("&h" & .Item(0).submatches(0)))
Else
With m_regex_decodedec.Execute(c)
If .Count Then
' 数値文字参照10進
str = str & Chr(.Item(0).submatches(0))
Else
' 文字実体参照でも数値文字参照でもない
str = str & c
End If
End With
End If
End With
End If
p = m.firstindex + m.Length
Next
str = str & Mid(s, p + 1)
decode = str
End Function
'EOF
例
Dim o As New HTMLEntity
Debug.Print o.decode("&")
Debug.Print o.decode("&"<>")
Debug.Print o.decode("A&")
Debug.Print o.decode("A&B")
Debug.Print o.decode("&B")
Debug.Print o.decode("ABC")
Debug.Print o.decode("ABC")
Debug.Print o.decode("ABC") ' 実体参照を含まない
Debug.Print o.decode("†‡") '
Debug.Print o.decode("A&B") ' 末尾に「;」がない
Debug.Print o.decode("あいうえ") ' 日本語
Debug.Print o.decode("あ&い") ' 日本語
Debug.Print o.decode("あ&い") ' 末尾に「;」がない
Debug.Print
Debug.Print o.encode("&")
Debug.Print o.encode("&""<>")
Debug.Print o.encode("A&")
Debug.Print o.encode("A&B")
Debug.Print o.encode("&B")
Debug.Print o.encode("ABC")
例の実行結果
ほかの方法
おそらく専ら問題になるのはデコードだと思います。正規表現を使わない方法となると，実体参照の種類だけReplace関数を実行するしかないように思えます。性能面でかなり問題が出るのではないでしょうか。
BASICって，そもそも文字列処理が得意ではない気がするので，あまり無理をすると不幸になる可能性が大です。どこからか実体参照を扱うCOMを調達した方がよいでしょう。