ネイバー国語辞典/英語辞書検索ツールの動作方法とソースコード
ネイバー国語辞書/英語辞書検索ツールの動作方式とソースコードについて説明する。
前の記事で続く内容だ。
1. ネイバー国語辞典/英語辞書検索ツールの動作方法と注意事項
ユーザがウェブブラウザを使用して検索語をネイバーサービスに検索を要求（Request）し、ネイバーサーバは要求に対する処理結果を応答（Response）する。
（Webの動作方法の詳細については、以下のGoogle検索結果の記事をお読みください。）
https://www.google.co.kr/search?q=web+アクション+方式
ネイバー辞書サービスの検索要求（Request）と応答（Response）について詳しく見てみましょう。
1.1。ネイバー辞書検索リクエストとレスポンス
Webブラウザを介してサーバーと送受信する内容を確認する方法はいくつかありますが、ここではFiddler Web Debuggerで説明します。
以下は、ネイバー国語辞典で「加入」という単語を検索したとき、リクエストと応答内容をFiddlerで確認した結果です。
- URL、Content-Type：以下の内容を確認できます。
- Protocol: HTTPS
- Host: ja.dict.naver.com
- URL: /api3/koko/search?query=%EA%B0%80%EC%9E%85&m=pc&hid=162470754628591300
- 여기에서 “%EA%B0%80%EC%9E%85″는 “가입”이 URL Encoding된 문자열이다.
- リクエスト(Request) Header
- User-Agent、Cookieなどの内容を確認できる。
- レスポンスの内容
- Content-Type: application/json;charset=UTF-8
- Responseの内容はjson形式で、character-setはUTF-8でエンコードされていることがわかります。
- Content-Length: 50814
- Responseの内容が50,814バイト、約50KBであることがわかります。
- Content-Body: {“searchResultMap”:{“searchResultListMap”:{“WORD”:{“query”:”登録”, …
- JSON文字列で、「JSON」タブで確認すると、次のように階層構造があります。
- Content-Type: application/json;charset=UTF-8
1.2.応答結果の形式を変更する（HTML - > JSON）
このツールは、ネイバーOpen APIを使用せずにWeb Request、Response方式を利用する。
正確ではないが、2018年12月を前後に応答結果の形式が変更された。それ以前はHTML形式だったが、この時期に偶然にFiddlerで確認してみるとJSON形式に応答が変更されたことが分かった。
このツールの最初のバージョンは、応答がHTML形式のときに作成されました。 HTMLから必要な項目を抽出したが、ネイバーがHTMLの構造を変更するたびに正しく動作せず、変更されたHTML構造に合わせて毎回ソースコードを変更してくれなければならなかった。応答結果形式がJSONに変更されて以来、ソースコードの変更なしにうまく動作している。
1.3。使用上の注意事項
ネイバーが辞書検索結果をJSON形式で提供すると公式に知らせたことを確認できない。 JSONの構造に関する文書も公開されていないようです。
（もし、公開されたニュースや資料があればコメントで教えてください。）
こういうわけである日、突然動作しなくなることがあるので注意してほしい。
2. 実装
2.1。全体の流れの概要
検索する単語をURLエンコーディングし、GetDataFromURL関数を実行してインポートしたJSON検索結果をparsingして必要な項目を抽出します。
Dim aWord As String, sBaseURL As String, sWord As String
aWord = "가입"
sBaseURL = "https://ko.dict.naver.com/api3/koko/search?query=%s" '기본 URL
sWord = URLEncodeUTF8(aWord) '검색어 URL Encoding
Dim sURL As String, sURLData As String, oParsedDic As Dictionary
sURL = Replace(sBaseURL, "%s", sWord) '기본 URL에 검색어 대입
sURLData = GetDataFromURL(sURL, "GET", "", "utf-8") 'URL에서 결과 가져오기
Set oParsedDic = JsonConverter.ParseJson(sURLData) 'JSON결과를 Dictionary로 변환
'JSON이 변환된 Dictionary에서 검색결과에 해당하는 항목 추출
'시작 Path: oParsedDic("searchResultMap")("searchResultListMap")("WORD")("items")
主な機能について見てみましょう。
2.2. URLエンコード（URLEncodeUTF8ソースコード）
検索要求するURLをURLEncodingした文字列として返します。 ADODB.Streamクラスを使用しました。
Public Function URLEncodeUTF8( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim bytes() As Byte, b As Byte, i As Integer, space As String
If SpaceAsPlus Then space = "+" Else space = "%20"
If Len(StringVal) > 0 Then
With New ADODB.Stream
.Mode = adModeReadWrite
.Type = adTypeText
.CharSet = "UTF-8"
.Open
.WriteText StringVal
.Position = 0
.Type = adTypeBinary
.Position = 3 ' skip BOM
bytes = .Read
End With
ReDim Result(UBound(bytes)) As String
For i = UBound(bytes) To 0 Step -1
b = bytes(i)
Select Case b
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
Result(i) = Chr(b)
Case 32
Result(i) = space
Case 0 To 15
Result(i) = "%0" & Hex(b)
Case Else
Result(i) = "%" & Hex(b)
End Select
Next i
URLEncodeUTF8 = Join(Result, "")
End If
End Function
ADODBライブラリを使用するには、「Microsoft ActiveX Data Object 6.1 Library」を参照して追加する必要があります。 Excel画面で Alt + F11 キーを押してVBA Editorに切り替えて追加してください。
2.3。 Request & Get Response (GetDataFromURL 関数ソースコード)
「WinHttp.WinHttpRequest」クラスを使用してRequest header、option情報を設定し、検索URLにアクセスして結果を取得します。 CreateObjectでオブジェクトを生成するlate binding方式なので、ライブラリ参照を追加する必要はありません。
Function GetDataFromURL(strURL, strMethod, strPostData, Optional strCharSet = "UTF-8")
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
'--------------------------------------------------------------------
'objWinHttp.SetProxy 2, "xxx.xxx.xxx.xxx:xxxx", "" 'Proxy를 사용하는 환경에서 설정
'--------------------------------------------------------------------
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.SetRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
Else
objWinHttp.SetRequestHeader "Content-type", "text/html; charset=euc-kr"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send (strPostData)
objWinHttp.WaitForResponse
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
'GetDataFromURL = objWinHttp.ResponseText
GetDataFromURL = BinaryToText(objWinHttp.ResponseBody, strCharSet)
Else
GetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
End Function
2.4。 Response（検索結果）JSON文字列
Response（検索結果）JSON文字列にはかなり多くの情報が含まれています。インデントと行区分がなく、見方が難しいが、見事に整理すれば以下の通り。 （一部のみ抜粋）
{ "searchResultMap": { "searchResultListMap": { "WORD": { "query": "登録", "queryRevert": "", "items": [ { "rank": "1", "gdid": " 8800000f_4002c436c93d4bb38d3e58632fe00af0", "matchType": "exact:entry", "entryId": "4002c436c93d4bb38d3e58632fe00af0", "Code ctTypeForm": "単語", "dictTypeForm": " 2", "sourceDictnameKO": "標準国語大辞典", "sourceDictnameOri": "Standard Korean Dict.", "sourceDictnameLink": "https://stdict.korean.go.kr/main/main.do", .. . "expEntry": "<strong>参加</strong>", ... "destinationLink": "#/entry/koko/4002c436c93d4bb38d3e58632fe00af0", ... "meansCollector": [ { "partOfSpeech": "名詞", "partOfSpeech2": "noun", "means": "order": "1", "value": "組織や団体などに入ったり、サービスを提供する商品などを申請する。", ... "exampleOri": "<strong>参加</strong> 申し込み。", ... }, { "order": "2", "value": "新しく追加する.", ... "exampleOri": "原稿の途中で修正された内容の <strong>参加</strong>が見つかった。", ... }, { "order": "3", "value": "条約文の認証手続きなしで、その条約にかかる行為。意思表示だけで当事者になることを可能にし、法共同体...", ..."languageGroup": "法律", ... "exampleTrans": null, ... } ] } ], "similarWordList": [] 、 "antonymWordList": [ { "antonymWordName": "退会", "antonymWordLink": "#/entry/koko/14e89175152b46569c2a2b6360e835ad" } ], "expAliasEntryAlwaysList": Value": "加入" } ], ... }, { "rank": "2", "gdid": "881857e6_e12c4e3432cf458c929bd49c929fd80b", "matchType": "exact:entry", "entryId": "e12c9c 0b", "serviceCode": "1 ", "languageCode": "KOKO", "expDictTypeForm": "単語", "dictTypeForm": "2", "sourceDictnameKO": "ウリマルサム", "sourceDictnameOri": "Urimalsaem", "sourceDictnameLink": "https: //opendict.korean.go.kr/main", ... "expEntry": "<strong>参加</strong>", ... "destinationLink": "#/entry/koko/e12c4e3432cf458c929bd49c929fd80b", ... "meansCollector": [ { "partOfSpeech": "名詞", "partOfSpeech2": "noun", " "order": "", "value": "どのオブジェクト群に新しいオブジェクトが追加されるか。ただし、一定の発育段階に達したオブジェクトだけが該当する。 "sectionType": "WORD", "revert": "", "orKEquery": null } } } }
2.5。 JSON parser
文字列関数（MID、INSTRなど）を使用してJSON文字列から目的の項目を抽出することはできますが、検索が複雑でコードが非常に汚れています。
Pythonで実装すれば簡単にjson moduleをインポートし、jsonクラスを使用すればよい。 VBAには公開されたライブラリがあまりありませんでしたが、幸いにもgithubに公開されたJSONパーサーがあり、よく使用しました。
https://github.com/VBA-tools/VBA-JSON
このJSON parserのソースコードは1,123行にもなり、ブログに載せない。必要な人は上記のURLでソースコードを確認してください。 JSON parserを使用する簡単な例は次のとおりです。（上記のgithubで公開されているコード）
Dim Json As Object
Set Json = JsonConverter.ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
' Json("a") -> 123
' Json("b")(2) -> 2
' Json("c")("d") -> 456
Json("c")("e") = 789
Debug.Print JsonConverter.ConvertToJson(Json)
' -> "{"a":123,"b":[1,2,3,4],"c":{"d":456,"e":789}}"
Debug.Print JsonConverter.ConvertToJson(Json, Whitespace:=2)
' -> "{
' "a": 123,
' "b": [
' 1,
' 2,
' 3,
' 4
' ],
' "c": {
' "d": 456,
' "e": 789
' }
' }"
2.6。検索ボタンクリックイベントソースコード
「事前検索」シートで「ネイバー辞書検索」ボタンをクリックしたときに実行されるコードです。以下の内容が実装されている。
- オプション設定がうまくいっていることを確認してください。
- 検索語に対して辞書検索を繰り返し実行し、結果をシートに表示する。
- 表示される結果はmatchType、searchEntry、meaning、link、類義語、反義語です。
- 実行中に「検索を中止」ボタンが押された場合、繰り返しを停止します。
Private Sub cmdRunDicSearch_Click()
Range("A1").Select
DoEvents
Dim bIsKorDicSearch As Boolean, bIsEngDicSearch As Boolean, sTargetDic As String
bIsKorDicSearch = chkKorDic.Value: bIsEngDicSearch = chkEngDic.Value
If (Not bIsKorDicSearch) And (Not bIsEngDicSearch) Then
MsgBox "검색 대상 사전중 적어도 1개는 선택해야 합니다", vbExclamation + vbOKOnly, "검색 대상 사전 확인"
Exit Sub
End If
Dim bIsMatchTypeExact As Boolean, bIsMatchTypeTermOr As Boolean, bIsMatchTypeAllTerm As Boolean '검색결과 표시 설정
bIsMatchTypeExact = chkMatchTypeExact.Value: bIsMatchTypeTermOr = chkMatchTypeTermOr.Value: bIsMatchTypeAllTerm = chkMatchTypeAllTerm.Value
If (bIsMatchTypeExact Or bIsMatchTypeTermOr Or bIsMatchTypeAllTerm) = False Then
MsgBox "검색결과 표시 설정중 적어도 하나는 선택해야 합니다.", vbExclamation + vbOKOnly, "확인"
Exit Sub
End If
If bIsKorDicSearch And Not bIsEngDicSearch Then sTargetDic = "국어사전"
If Not bIsKorDicSearch And bIsEngDicSearch Then sTargetDic = "영어사전"
If bIsKorDicSearch And bIsEngDicSearch Then sTargetDic = "국어사전, 영어사전"
Dim lMaxResultCount As Long
lMaxResultCount = CInt(txtMaxResultCount.Value)
If MsgBox("사전 검색을 시작하시겠습니까?" + vbLf + _
"대상 사전: " + sTargetDic + vbLf + _
"결과출력 제한개수: " + CStr(lMaxResultCount) _
, vbQuestion + vbYesNoCancel, "확인") <> vbYes Then Exit Sub
Dim i As Long, iResultOffset As Long
bIsWantToStop = False
DoEvents
Dim sWord As String, oKorDicSearchResult As TDicSearchResult, oEngDicSearchResult As TDicSearchResult
Dim oBaseRange As Range
Set oBaseRange = Range("검색결과Header").Offset(1, 0)
oBaseRange.Select
For i = 0 To 100000
If bIsWantToStop Then
MsgBox "사용자의 요청으로 검색을 중단합니다.", vbInformation + vbOKOnly, "확인"
Exit For
End If
If chkSkipIfResultExists.Value = True And _
oBaseRange.Offset(i, 1) <> "" Then GoTo Continue_For '이미 내용이 있으면 Skip
sWord = oBaseRange.Offset(i)
If sWord = "" Then Exit For
oBaseRange.Offset(i).Select
Application.ScreenUpdating = False
If bIsKorDicSearch Then '국어사전 검색결과 표시
oKorDicSearchResult = DoDicSearch(dtsKorean, sWord, bIsMatchTypeExact, bIsMatchTypeTermOr, bIsMatchTypeAllTerm, lMaxResultCount)
oBaseRange.Offset(i, 1).Select
With oKorDicSearchResult
oBaseRange.Offset(i, 1) = .sMatchType
oBaseRange.Offset(i, 2) = .sSearchEntry
oBaseRange.Offset(i, 3) = .sMeaning
If oKorDicSearchResult.sLinkURL <> "" Then
With ActiveSheet.Hyperlinks.Add(Anchor:=oBaseRange.Offset(i, 4), Address:=.sLinkURL, TextToDisplay:="네이버국어사전 열기: " & .sLinkWord)
.Range.Font.Size = 8
End With
End If
oBaseRange.Offset(i, 5) = .sSynonymList
oBaseRange.Offset(i, 6) = .sAntonymList
End With
End If
If bIsEngDicSearch Then '영어사전 검색결과 표시
oEngDicSearchResult = DoDicSearch(dtsEnglish, sWord, bIsMatchTypeExact, bIsMatchTypeTermOr, bIsMatchTypeAllTerm, lMaxResultCount)
'oBaseRange.Offset(i, 7).Select
With oEngDicSearchResult
oBaseRange.Offset(i, 7) = .sMatchType
oBaseRange.Offset(i, 8) = .sSearchEntry
oBaseRange.Offset(i, 9) = .sMeaning
If oKorDicSearchResult.sLinkURL <> "" Then
With ActiveSheet.Hyperlinks.Add(Anchor:=oBaseRange.Offset(i, 10), Address:=.sLinkURL, TextToDisplay:="네이버영어사전 열기: " & .sLinkWord)
.Range.Font.Size = 8
End With
End If
oBaseRange.Offset(i, 11) = .sSynonymList
oBaseRange.Offset(i, 12) = .sAntonymList
End With
End If
Application.ScreenUpdating = True
Continue_For:
DoEvents
Next i
MsgBox "사전 검색을 완료하였습니다", vbOKOnly + vbInformation
End Sub
2.7。事前検索（DoDicSearchソースコード）
1つの検索語に対して検索要求を送信し、結果を受け取り、必要な項目を抽出して返す関数です。
- JSON文字列を辞書としてparsing：49行
- matchType, searchEntry, meaning, link, 類義語, 反義語項目抽出: 53～106行
Const DICT_ROOT_URL_KO As String = "https://ko.dict.naver.com/"
Const DICT_BASE_URL_KO As String = "https://ko.dict.naver.com/api3/koko/search?query=%s"
Const DICT_ROOT_URL_EN As String = "https://en.dict.naver.com/"
Const DICT_BASE_URL_EN As String = "https://en.dict.naver.com/api3/enko/search?query=%s"
Public Enum DicToSearch
dtsKorean = 1
dtsEnglish = 2
dtsAll = 10
End Enum
Public Type TDicSearchResult
sWord As String
sMatchType As String
sSearchEntry As String
sMeaning As String
sLinkURL As String
sLinkWord As String
sSynonymList As String
sAntonymList As String
End Type
Public Function DoDicSearch(aDicToSearch As DicToSearch, aWord As String, _
bIsMatchTypeExact As Boolean, bIsMatchTypeTermOr As Boolean, bIsMatchTypeAllTerm As Boolean, _
aMaxResultCount As Long) As TDicSearchResult
Dim sDicRootURL As String, sBaseURL As String, sURL As String, sURLData As String, sWord As String, oDicSearchResult As TDicSearchResult
Dim oParsedDic As Dictionary
Dim oItem As Dictionary, oMeansCollector As Dictionary, oMeans As Dictionary
Dim oSimWords As Dictionary, oAntWord As Dictionary
Dim sPOS As String, sMeaning As String, sLinkURL As String, sLinkWord As String
Dim s유의어 As String, s유의어목록 As String, s반의어 As String, s반의어목록 As String
Dim sMatchType As String, sSearchEntry As String, sHandleEntry As String
Select Case aDicToSearch
Case dtsKorean
sDicRootURL = DICT_ROOT_URL_KO
sBaseURL = DICT_BASE_URL_KO
Case dtsEnglish
sDicRootURL = DICT_ROOT_URL_EN
sBaseURL = DICT_BASE_URL_EN
End Select
If aWord = "" Then Exit Function
sWord = URLEncodeUTF8(aWord)
sURL = Replace(sBaseURL, "%s", sWord)
sURLData = GetDataFromURL(sURL, "GET", "", "utf-8") 'URL에서 결과 가져오기
Set oParsedDic = JsonConverter.ParseJson(sURLData) 'JSON결과를 Dictionary로 변환
Dim lMatchIdx As Long: lMatchIdx = 0
Dim lResultCount As Long: lResultCount = 0
For Each oItem In oParsedDic("searchResultMap")("searchResultListMap")("WORD")("items")
lResultCount = lResultCount + 1
If (aMaxResultCount <> 0) And (lResultCount > aMaxResultCount) Then Exit For '결과출력 제한개수 초과시 Loop 종료
s유의어 = "": s반의어 = ""
lMatchIdx = lMatchIdx + 1
'If oItem("matchType") <> "exact:entry" Then Exit For
sHandleEntry = oItem("handleEntry")
Select Case oItem("matchType")
Case "exact:entry"
sLinkWord = sHandleEntry
sLinkURL = sDicRootURL + oItem("destinationLink")
If Not bIsMatchTypeExact Then GoTo Continue_InnerFor
Case "term:or"
If Not bIsMatchTypeTermOr Then GoTo Continue_InnerFor
Case "allterm:proximity:1.000000"
If Not bIsMatchTypeAllTerm Then GoTo Continue_InnerFor
Case Else
End Select
sMatchType = sMatchType + IIf(sMatchType = "", "", vbLf) & CStr(lMatchIdx) & ". " & oItem("matchType")
sSearchEntry = sSearchEntry + IIf(sSearchEntry = "", "", vbLf) & CStr(lMatchIdx) & ". " & sHandleEntry
For Each oMeansCollector In oItem("meansCollector")
'Debug.Print "품사: " & oMeansCollector("partOfSpeech")
sPOS = ""
If oMeansCollector.Exists("partOfSpeech") Then
If Not IsNull(oMeansCollector("partOfSpeech")) Then sPOS = oMeansCollector("partOfSpeech")
End If
For Each oMeans In oMeansCollector("means")
'Debug.Print "뜻: " & oMeans("value")
If oMeans.Exists("value") Then
If Not IsNull(oMeans("value")) Then _
sMeaning = sMeaning + IIf(sMeaning = "", "", vbLf) & CStr(lMatchIdx) & ". " & IIf(sPOS = "", "", "[" & sPOS & "] ") & RemoveHTML(oMeans("value"))
End If
Next oMeans
Next oMeansCollector
For Each oSimWords In oItem("similarWordList")
If oSimWords.Exists("similarWordName") Then _
s유의어 = s유의어 + IIf(s유의어 = "", "", ", ") & RemoveHTML(oSimWords("similarWordName"))
Next oSimWords
If s유의어 <> "" Then _
s유의어목록 = s유의어목록 & IIf(s유의어목록 = "", "", vbLf) & CStr(lMatchIdx) & ". " & sHandleEntry & ": " & s유의어
For Each oAntWord In oItem("antonymWordList")
If oAntWord.Exists("antonymWordName") Then _
s반의어 = s반의어 + IIf(s반의어 = "", "", ", ") & RemoveHTML(oAntWord("antonymWordName"))
Next oAntWord
If s반의어 <> "" Then _
s반의어목록 = s반의어목록 & IIf(s반의어목록 = "", "", vbLf) & CStr(lMatchIdx) & ". " & sHandleEntry & ": " & s반의어
Continue_InnerFor:
Next oItem
If sMeaning = "" Then
sMeaning = "#NOT FOUND#": sMatchType = sMeaning: sSearchEntry = sMeaning
End If
'결과값 반환
With oDicSearchResult
.sWord = aWord
.sMatchType = sMatchType
.sSearchEntry = sSearchEntry
.sMeaning = sMeaning
.sLinkWord = sLinkWord
.sLinkURL = Replace(sLinkURL, "#", "%23") 'Excel에서 #기호를 내부적으로 #20 - #20 으로 치환하는 것을 방지
.sSynonymList = s유의어목록
.sAntonymList = s반의어목록
End With
DoDicSearch = oDicSearchResult
End Function
以上で、このツールの動作方式、注意事項、ソースコードについて調べた。道具を使ってみた方の後期や、気になる点、必要な機能など意見はコメントで残してほしい。
<< 関連記事のリスト >>
日本語 
한국어 
English 
简体中文 
Deutsch 
Español
Absolutely with you it agree. It is excellent idea. I support you.
_ _ _ _ _ _ _ _ _ _ _ _ _ _
Nekultsy Ivan dxvk github
Thanks a lot.
Please take a look other article in my blog ^^