YAS's VB.NET Tips
 
VB.NET Tips
VB.NET Tips
1234
2022/02/20

VBでRaspberry Pi PICOにファイルを転送する

| by:YAS
 Raspberry Pi PICOにファイルを転送するには、Thonnyなどを使えば簡単にできますが、PICOを使った自作VOCAにWAVEファイルを転送しようとすると、簡単にできる方法はなさそうです。バイナリ配列の内容をファイルを書き込むコードをREPLモードで実行してみましたが、メモリ不足のエラーが出て、ごく小さいファイルしか転送できませんでした。そこで、仮想COMポートのcom0comを使ってThonnyの通信内容を解読したところ、2kbyteずつ送信・書き込みを行っていることがわかりました。
 下のサンプルコードはtest.wavをPICOのルートディレクトリに転送します。コードをForm1にコピー・貼り付けすれば動作します。

Form1.vb

11:05 | コメント(0)
2022/02/13

Google Text-to-SpeechをVBから利用する

| by:YAS
 以前、「VoiceTextサンプル」で、VoiceText(現在はReadSpeakerと改名)でWebAPIを使ってしゃべらせるサンプルを作成しました。ただ、ReadSpeakerの音声は個人的に聞くことに制限されていて、人に聞かせるためのアプリケーションで用いることは禁止されています。(一太郎付属の詠太も同様)
 そこで、今度は利用制限がゆるそうなGoogle Text-to Speechを使ってみることにしました。
 下のサンプルは、まず、「Google Cloud Text-to-Speech の使い方 日本語テキストを読み上げさせてみよう」などを参考にして、Google Cloud Platformのアカウントを取得し、Google Cloud SDKをインストールし、Text-to-Speech APIを有効化します。認証ファイルを取得したら、「credential.json」にリネームし、実行ファイルと同じフォルダに配置きます。その後、コードをコピー・貼り付けすれば動作します。

Form1.vb

15:59 | コメント(0)
2022/02/12

GhostScriptで一時ファイルを作らずにPDFのサムネイルを作成する

| by:YAS
 以前、「PDFをJPEGに変換する」で、GhostScriptでPDFを画像化してファイルに保存することができました。
 しかし、各ページをサムネイルで表示したい場合などでは、むやみにファイルを作らず、メモリ上でdllとやり取りをしたいと思います。
 「gsapi_set_display_callback()」を使うことで、コールバック関数で、dllが生成した画像を直接受け取ることができました。
 詳しくはサンプルのコードをご覧ください。
 サンプルは,下のコードをコピー・貼り付けし、実行ファイルと同じフォルダにGhostSciptから抽出した「gsdll64.dll」と、適当なPDFを「test.pdf」とリネームして配置すれば動作します。32bit環境では、「gsdll32.dll」を配置し、定数gsdllを「gsdll32.dll」に書き換えてください。

Form1.vb

mdlGhostScript.vb

07:48 | コメント(0)
2021/07/17

WebView2でファイルアップロードを自動化する

| by:YAS
 2021年ともなると,IEを使うのはさすがに厳しい状況です。ソフトウェアにブラウザを組み込むにしても,WebBrowserコントロールではなく,WebView2を使うことになります。以前作ったNetCommons2へのアップロードを自動化するために,「開く」ダイアログに自動的にファイルのパスを入力するサンプルをWebView2用に変更してみました。
 WebView2コントロールを使うには,新規プロジェクトを作成してから,「プロジェクト」-「NuGetパッケージの管理」から「Microsoft.Web.WebView2」をインストールします。
 サンプルは,下のコードをコピー・貼り付けすれば動作します。
 ※WebView2OpenDialogAutomaticInput.vbのコードをアップロードする際に間違えて違うコードをアップロードしていました。2022/01/09に修正しました。
Form1.vb

WebView2OpenDialogAutomaticInput.vb

13:52 | コメント(0)
2020/05/22

MeCabの辞書をコマンドラインで指定する

| by:YAS
 MeCabをインストールしないで,VBからMeCabを使うために,辞書を起動オプションで指定する。MeCabをインストールしたフォルダから,実行ファイルのフォルダに辞書をコピーして使う場合は,

mecab_new2(" --rcfile=.\dic\ipadic\dicrc --dicdir=.\dic\ipadic")

もしくは,

mecab_new2(" -r .\dic\ipadic\dicrc -d .\dic\ipadic")

のようにオプションを指定する。(一文字目は半角空白)

参考Webページ MeCabで辞書の読込先を変える方法
        http://awakia-n.hatenablog.com/entry/20080212/1202811277
        コマンドラインオプション
        https://taku910.github.io/mecab/mecab.html
Imports System.Runtime.InteropServices

Public Class Form1

    Dim TextBox1 As New TextBox

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.TextBox1.Multiline = True
        Me.TextBox1.ScrollBars = ScrollBars.Vertical
        Me.TextBox1.Dock = DockStyle.Fill
        Me.Controls.Add(Me.TextBox1)
        Using Mecab As New MeCab("  --rcfile=.\dic\ipadic\dicrc --dicdir=.\dic\ipadic")
            Me.TextBox1.Text = Mecab.Parse("和布蕪を使って日本語文字列を形態素分析する。").Replace(vbLf, vbCrLf)
        End Using
    End Sub

End Class

Class MeCab
    Implements IDisposable

    <DllImport("libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    Public Shared Function mecab_new2(ByVal arg As String) As IntPtr
    End Function

    <DllImport("libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    Public Shared Function mecab_sparse_tostr(ByVal m As IntPtr, ByVal str As String) As IntPtr
    End Function

    <DllImport("libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    Public Shared Sub mecab_destroy(ByVal m As IntPtr)
    End Sub

    Private ptrMeCab As IntPtr

    Sub New()
        Me.New(String.Empty)
    End Sub

    Sub New(ByVal Arg As String)
        ptrMeCab = mecab_new2(Arg)
    End Sub

    Public Function Parse(ByVal [String] As String) As String
        Dim ptrResult As IntPtr = mecab_sparse_tostr(ptrMeCab, [String])
        Dim strResult As String = Marshal.PtrToStringAnsi(ptrResult)
        Return strResult
    End Function

    Public Overloads Sub Dispose() Implements IDisposable.Dispose
        mecab_destroy(ptrMeCab)
        GC.SuppressFinalize(Me)
    End Sub

    Protected Overrides Sub Finalize()
        Dispose()
    End Sub

End Class

MeCabで辞書の読込先を変える方法
20:18 | コメント(0)
2018/09/08

ぷりんときっずダウンローダーVer.2.0

| by:YAS
 前回,プリントキッズの1ページ分のプリントをまとめてダウンロードするコードを考えた。今回は,カテゴリを指定して,カテゴリ内のすべてのプリントをダウンロードするコードを考える。
 最上位のカテゴリは左図のメニューとする。このメニューは下のようはHTMLになっている。id="picture"の要素を検索し,その中のa要素を検索すればカテゴリ一覧のリンクを取得できそうだ。

 上のカテゴリを選択すると,左図のような下位カテゴリが表示される。class="text-anime"のaside要素を検索し,その中のa要素を検索すれば下位カテゴリ一覧のリンクを取得できそうだ。
 
 左図が完成したものです。表示しているページのカテゴリ一覧からダウンロードするカテゴリページを選択し,再帰的に検索してPDFファイルをダウンロードします。

(プリントキッズのアイコンはfaviconを起動時にダウンロードして表示しています。)

バイナリのダウンロードページ
 Ver.1.0をもとに,機能追加,バグ修正,リファクタリングを行ったのが,下のコードです。Dialogを追加し,Form1とDialog1に下のコードをコピーすれば動作します。
【Form1】
【Dialog1】

21:56 | コメント(0)
2018/09/04

ぷりんときっずダウンローダーVer.1.0

| by:YAS
 ぷりんときっずの無料プリントをよく利用させていただいている。フォントが丸文字のプリントもあったりするが,わざわざ教科書体で作り直してくださったものもあり,ありがたく活用させていただいている。
 まとめてダウンロードしたいプリントも多いのだが,一括ダウンロードはできないようなので,専用のダウンローダーを作成してみる。
 あまり負荷をかけるのもよくないとは思うが,かなり高速なレスポンスのサーバーのようなので,個人的にダウンローダーを作成して使う分には問題なさそうだと思っている。
 まずは,1ページにまとめられているPDFのプリントをすべてダウンロードしてみる。
 chromeでPDFのリンクを右クリック→検証で,デベロッパーツールでHTMLを確認すると,PDFのダウンロードページのPDFへのリンク部分は左のようになっている。
 PDFファイルへのリンクは,id="topic"のdiv要素を検索し,その中のa要素を検索して取得することにする。

※id="easy"のdiv要素内に「簡単」レベルのプリントが,id="normal"のdiv要素内に「普通」レベルのプリントが,id="hard"のdiv要素内に「難しい」レベルのプリントが格納されている。


 1つ1つのPDFファイルへのリンクは下のようなHTMLになっている。ファイル名からプリントを探しやすくするために,a要素内のp要素のInnerTextをファイル名として保存する。


 プリントの分類をわかりやすくするために,ダウンロードしたPDFフィアルを格納するフォルダは,下のパンくずリストをフォルダ名にする。


 パンくずリストは,id="pan-nav"のdiv要素を取得し,その中のspan要素のInnerTextから取得する。



 下のコードをフォームのコードにコピー・貼り付けをすれば動作します。
Option Explicit On
Option Strict On

Imports System.IO
Imports Microsoft.Win32

Public Class Form1

    
Private ToolStrip As New ToolStrip
    
Private WithEvents tsbDownload As New ToolStripButton With {.Text = "ダウンロード"}
    
Private StatusStrip As New StatusStrip
    
Private WithEvents tspProgress As New ToolStripProgressBar
    
Private tslStatus As New ToolStripLabel
    
Private WithEvents WebBrowser As New WebBrowser With {.Dock = DockStyle.Fill}
    
Private baseUrl As New Uri("https://print-kids.net/")

    
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        
Me.Text = "ぷりんときっずダウンローダー"
        
Me.Size = New Size(1024, 678)
        BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
        
Me.WebBrowser.ScriptErrorsSuppressed = True
        
Me.ToolStrip.Items.Add(tsbDownload)
        
Me.StatusStrip.Items.AddRange({tspProgress, tslStatus})
        
Me.Controls.AddRange({Me.ToolStrip, Me.WebBrowser, Me.StatusStrip})
        
Me.WebBrowser.Navigate(baseUrl)
    
End Sub

    
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        BrowserEmulation.DeleteRenderingModeRegkey()
    
End Sub

    
Private Sub tsbDownload_Click(sender As Object, e As EventArgs) Handles tsbDownload.Click
        downloadPdfs(
Me.WebBrowser.Url)
    
End Sub

    
Private Sub downloadPdfs(url As Uri)
        
Dim tempWebBrowser As New WebBrowser
        tempWebBrowser.ScriptErrorsSuppressed = 
True
        
AddHandler tempWebBrowser.DocumentCompleted, AddressOf WebBrowser_DocumentCompleted
        tempWebBrowser.Navigate(url)
    
End Sub

    
Private Sub WebBrowser_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs)
        
Dim Browser As WebBrowser = DirectCast(sender, WebBrowser)
        
If e.Url.Equals(Browser.Url) Then
            
'PDFファイルのリンクを取得
            
Dim pdfLinks = Browser.Document.GetElementById("topic").GetElementsByTagName("a").Cast(Of HtmlElement) _
                .Select(
Function(anchorTag) New With {.AnchorElement = anchorTag, .Uri = New Uri(anchorTag.GetAttribute("href"))}) _
                .Where(
Function(anchorTag) baseUrl.IsBaseOf(anchorTag.Uri) AndAlso Path.GetExtension(anchorTag.Uri.AbsoluteUri).ToLower = ".pdf") _
                .Select(
Function(anchorTag) New With {anchorTag.Uri, .Text = anchorTag.AnchorElement.GetElementsByTagName("p")(0).InnerText})
            
'パンなびリストを取得
            
Dim downloadDir = Browser.Document.GetElementById("pan-nav").GetElementsByTagName("span").Cast(Of HtmlElement) _
                .Select(
Function(spanTag) spanTag.InnerText) _
                .Aggregate(
String.Empty, Function(result As String, title As String) Path.Combine(result, title))
            
'ダウンロード先フォルダ作成
            downloadDir = Path.Combine(My.Computer.FileSystem.SpecialDirectories.Desktop, downloadDir)
            
If Not Directory.Exists(downloadDir) Then
                My.Computer.FileSystem.CreateDirectory(Path.Combine(downloadDir))
            
End If
            
'PDFファイルをダウンロード
            
Dim Progress As Integer = 0
            
Me.tspProgress.Maximum = pdfLinks.Count
            
Me.tspProgress.Value = Progress
            
Me.tslStatus.Text = ""
            
Me.StatusStrip.Refresh()
            
For Each pdfLink In pdfLinks
                
Dim DownloadFileName As String = Path.Combine(downloadDir, pdfLink.Text.Replace(" """) & ".pdf")
                
Dim DownloadUrl As String = Path.GetFileName(pdfLink.Uri.AbsoluteUri)
                
Dim Status As String = " スキップ"
                
If Not File.Exists(DownloadFileName) Then
                    My.Computer.Network.DownloadFile(pdfLink.Uri, DownloadFileName)
                    Status = 
" ダウンロード中..."
                
End If
                
Me.tspProgress.Value = Progress
                
Me.tslStatus.Text = Progress + 1 & "/" & Me.tspProgress.Maximum & " " & DownloadUrl & Status
                
Me.StatusStrip.Refresh()
                Progress += 1
            
Next
            
Me.tspProgress.Value = Me.tspProgress.Maximum
            
Me.tslStatus.Text = "ダウンロード完了"
            
Me.StatusStrip.Refresh()
            Browser.Dispose()
        
End If
    
End Sub

End Class

Public Class BrowserEmulation

    
Public Enum Emulation
        IE11Edge = 11001
        IE11 = 11000
        IE10Std = 10001
        IE10 = 10000
        IE9Std = 9999
        IE9 = 9000
        IE8Std = 8888
        IE8 = 8000
        IE7 = 7000
    
End Enum

    
Private Const FEATURE_BROWSER_EMULATION As String = "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION"

    
Public Shared Sub CreateRenderingModeRegkey(EmulationMode As Emulation)
        
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
            Regkey.SetValue(GetReleaseBuildName, EmulationMode, RegistryValueKind.DWord)
            Regkey.SetValue(GetDebugBuildName, EmulationMode, RegistryValueKind.DWord)
        
End Using
    
End Sub

    
Public Shared Sub DeleteRenderingModeRegkey()
        
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
            Regkey.DeleteValue(GetReleaseBuildName)
            Regkey.DeleteValue(GetDebugBuildName)
        
End Using
    
End Sub

    
Private Shared Function GetReleaseBuildName() As String
        
Return Path.GetFileName(Application.ExecutablePath)
    
End Function

    
Private Shared Function GetDebugBuildName() As String
        
Return GetReleaseBuildName.Replace(".exe"".svhost.exe")
    
End Function

End Class

22:23 | コメント(0)
2018/06/29

MeCabを使ってWebBrowserにルビをふる

| by:YAS
 日本語形態素分析エンジンMeCabを使って,WebBrowserの表示にルビを振ります。
 クロスドメインのiframe以外は,iframeの中も再帰的にテキストノードを検索してMeCabで分析し,ルビエレメントノードに置き換えます。(クロスドメインのiframeにアクセスしようとした際の例外(UnauthorizedAccessException)は握りつぶしています。)
 マネージコードだけでは,テキストノードを取得できないので,mshtmlを参照設定して使用しています。COMオブジェクトの開放はやっているつもりですが,完全ではないかもしれません。

まず,Microsoft HTML Object Libraryを参照設定してください。
次に,下のコードをフォームのコードにコピー・貼り付けをすれば動作します。

Option Explicit On
Option Strict On

Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports Microsoft.Win32
Imports mshtml

Public Class Form1

    
Private WithEvents WebBrowser As New WebBrowser With {.Dock = DockStyle.Fill}
    
Private MeCab As New MeCab("--node-format=[#%M:%f[7]:%f[0]#] --unk-format=%M --eos-format=\0")

    
Public Enum NODETYPE As UShort
        ELEMENT_NODE = 1
        TEXT_NODE = 3
        PROCESSING_INSTRUCTION_NODE = 7
        COMMENT_NODE = 8
        DOCUMENT_NODE = 9
        DOCUMENT_TYPE_NODE = 10
        DOCUMENT_FRAGMENT_NODE = 11
    
End Enum

    
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
        
Me.WebBrowser.ScriptErrorsSuppressed = True
        
Me.Controls.Add(Me.WebBrowser)
        
Me.WebBrowser.GoHome()
    
End Sub

    
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        BrowserEmulation.DeleteRenderingModeRegkey()
        MeCab.Dispose()
    
End Sub

    
Private Sub WebBrowser_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser.DocumentCompleted
        
Dim domElement As IHTMLDOMNode = DirectCast(Me.WebBrowser.Document.Body.DomElement, IHTMLDOMNode)
        AttachRuby(domElement)
        Marshal.FinalReleaseComObject(domElement)
    
End Sub

    
'テキストノードを検索してMeCabで処理する
    
Private Sub AttachRuby(ByVal node As IHTMLDOMNode)
        
Select Case node.nodeName.ToLower
            
Case "ruby""select"
                
Return
        
End Select
        
Dim document As IHTMLDocument2 = Nothing
        
Dim childNodes As IHTMLDOMChildrenCollection = Nothing
        
Try
            document = 
DirectCast(DirectCast(node, IHTMLDOMNode2).ownerDocument, IHTMLDocument2)
            childNodes = 
DirectCast(node.childNodes, IHTMLDOMChildrenCollection)
            
For Each childNode As IHTMLDOMNode In childNodes
                
Try
                    
If childNode.nodeType = NODETYPE.TEXT_NODE Then
                        
Dim childNodeValue As String = DirectCast(childNode.nodeValue, String)
                        
If Regex.IsMatch(childNodeValue, "[\u4E00-\u9FFF\u3040-\u309F\u30A0-\u30FA]"Then
                            
'MeCabでテキストノードを解析する
                            
Dim result As String = MeCab.Parse(childNodeValue)
                            
'解析結果をルビタグに置き換える
                            result = Regex.Replace(result, 
"\[#(.+?):(.+?):(.+?)\#]"New MatchEvaluator(AddressOf RegexMatchEvaluator))
                            
'テキストノードをルビエレメントノードに置き換える
                            
Dim newElement As IHTMLElement = Nothing
                            
Try
                                newElement = document.createElement(
String.Empty)
                                newElement.innerHTML = result
                                childNode.replaceNode(
DirectCast(newElement, IHTMLDOMNode))
                            
Finally
                                
If newElement IsNot Nothing Then
                                    Marshal.ReleaseComObject(newElement)
                                
End If
                            
End Try
                        
End If
                    
Else
                        
If childNode.nodeName.ToLower = "frame" Or childNode.nodeName.ToLower = "iframe" Then
                            
Dim frame As IHTMLWindow2 = Nothing
                            
Dim frameDocument As IHTMLDocument2 = Nothing
                            
Dim frameBody As IHTMLElement = Nothing
                            
Try
                                frame = 
DirectCast(childNode, IHTMLFrameBase2).contentWindow
                                frameDocument = frame.document
                                frameBody = frameDocument.body
                                AttachRuby(
DirectCast(frameBody, IHTMLDOMNode)) 'フレーム内を再帰的に処理
                            
Catch ex As UnauthorizedAccessException
                            
Finally
                                
If frameBody IsNot Nothing Then
                                    Marshal.ReleaseComObject(frameBody)
                                
End If
                                
If frameDocument IsNot Nothing Then
                                    Marshal.ReleaseComObject(frameDocument)
                                
End If
                                
If frame IsNot Nothing Then
                                    Marshal.ReleaseComObject(frame)
                                
End If
                            
End Try
                        
Else
                            
If childNode.hasChildNodes Then
                                AttachRuby(childNode) 
'子エレメントを再帰的に処理
                            
End If
                        
End If
                    
End If
                
Finally
                    
If childNode IsNot Nothing Then
                        Marshal.ReleaseComObject(childNode)
                    
End If
                
End Try
            
Next
        
Finally
            
If childNodes IsNot Nothing Then
                Marshal.ReleaseComObject(childNodes)
            
End If
            
If document IsNot Nothing Then
                Marshal.ReleaseComObject(document)
            
End If
        
End Try
    
End Sub

    
Private Function RegexMatchEvaluator(ByVal M As Match) As String
        
Dim kanji As String = M.Groups(1).Value '漢字
        
Dim kana As String = StrConv(M.Groups(2).Value, VbStrConv.Hiragana) 'かな
        
Dim result As String = kanji
        
If Regex.IsMatch(kanji, "\p{IsCJKUnifiedIdeographs}"Then
            result = 
"<ruby>" & kanji & "<rt>" & kana & "</rt></ruby>"
        
End If
        
Return result
    
End Function

End Class

Public Class BrowserEmulation

    
Public Enum Emulation
        IE11Edge = 11001
        IE11 = 11000
        IE10Std = 10001
        IE10 = 10000
        IE9Std = 9999
        IE9 = 9000
        IE8Std = 8888
        IE8 = 8000
        IE7 = 7000
    
End Enum

    
Private Const FEATURE_BROWSER_EMULATION As String = "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION"

    
Public Shared Sub CreateRenderingModeRegkey(EmulationMode As Emulation)
        
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
            Regkey.SetValue(GetReleaseBuildName, EmulationMode, RegistryValueKind.DWord)
            Regkey.SetValue(GetDebugBuildName, EmulationMode, RegistryValueKind.DWord)
        
End Using
    
End Sub

    
Public Shared Sub DeleteRenderingModeRegkey()
        
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
            Regkey.DeleteValue(GetReleaseBuildName)
            Regkey.DeleteValue(GetDebugBuildName)
        
End Using
    
End Sub

    
Private Shared Function GetReleaseBuildName() As String
        
Return Path.GetFileName(Application.ExecutablePath)
    
End Function

    
Private Shared Function GetDebugBuildName() As String
        
Return GetReleaseBuildName.Replace(".exe"".svhost.exe")
    
End Function

End Class

Public Class MeCab
    
Implements IDisposable

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Function mecab_new2(ByVal arg As StringAs IntPtr
    
End Function

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Function mecab_sparse_tostr(ByVal m As IntPtr, ByVal str As StringAs IntPtr
    
End Function

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Sub mecab_destroy(ByVal m As IntPtr)
    
End Sub

    
Private ptrMeCab As IntPtr

    
Sub New()
        
Me.New(String.Empty)
    
End Sub

    
Sub New(ByVal Arg As String)
        ptrMeCab = mecab_new2(Arg)
    
End Sub

    
Public Function Parse(ByVal [String] As StringAs String
        
Dim ptrResult As IntPtr = mecab_sparse_tostr(ptrMeCab, [String])
        
Dim strResult As String = Marshal.PtrToStringAnsi(ptrResult)
        
Return strResult
    
End Function

    
Public Overloads Sub Dispose() Implements IDisposable.Dispose
        mecab_destroy(ptrMeCab)
        GC.SuppressFinalize(
Me)
    
End Sub

    
Protected Overrides Sub Finalize()
        Dispose()
    
End Sub

End Class

22:20 | コメント(0)
2018/06/28

日本語形態素分析エンジンMeCabをVBより利用する

| by:YAS
 MeCab0.996にはCより利用可能なdllがバイナリで付属しています。これをDllImportで宣言し,VBから利用します。
 以下のサンプルは文字列をMeCabで形態素分析し,結果をTextBoxに表示します。なお,サンプルを実行するには,Mecab0.996をあらかじめデフォルトのフォルダにインストールし,libmecab.dllをバイナリと同じフォルダにコピーしておく必要であります。 IFELanguageのGetJMorphResultよりも利用が簡単で,私が考えたコードで安定して動作しています。

 下のコードをフォームのコードにコピー・貼り付けをすれば動作します。
Imports System.Runtime.InteropServices

Public Class Form1

    
Dim TextBox1 As New TextBox

    
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        
Me.TextBox1.Multiline = True
        
Me.TextBox1.ScrollBars = ScrollBars.Vertical
        
Me.TextBox1.Dock = DockStyle.Fill
        
Me.Controls.Add(Me.TextBox1)
        
Using Mecab1 As New MeCab
            
Me.TextBox1.Text = Mecab1.Parse("和布蕪を使って日本語文字列を形態素分析する。").Replace(vbLf, vbCrLf)
        
End Using
    
End Sub

End Class

Class MeCab
    
Implements IDisposable

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Function mecab_new2(ByVal arg As StringAs IntPtr
    
End Function

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Function mecab_sparse_tostr(ByVal m As IntPtr, ByVal str As StringAs IntPtr
    
End Function

    <DllImport(
"libmecab.dll", CallingConvention:=CallingConvention.Cdecl)>
    
Public Shared Sub mecab_destroy(ByVal m As IntPtr)
    
End Sub

    
Private ptrMeCab As IntPtr

    
Sub New()
        
Me.New(String.Empty)
    
End Sub

    
Sub New(ByVal Arg As String)
        ptrMeCab = mecab_new2(Arg)
    
End Sub

    
Public Function Parse(ByVal [String] As StringAs String
        
Dim ptrResult As IntPtr = mecab_sparse_tostr(ptrMeCab, [String])
        
Dim strResult As String = Marshal.PtrToStringAnsi(ptrResult)
        
Return strResult
    
End Function

    
Public Overloads Sub Dispose() Implements IDisposable.Dispose
        mecab_destroy(ptrMeCab)
        GC.SuppressFinalize(
Me)
    
End Sub

    
Protected Overrides Sub Finalize()
        Dispose()
    
End Sub

End Class


※このTipsは2005年頃にNiftyの@homepageで公開していたもの一部変更して再掲載しました。
 http://homepage1.nifty.com/yasunari/VB/VB2005/MeCab.htm
20:33 | コメント(0)
2018/06/24

MS-IMEでモノルビを取得する

| by:YAS
 MS-IMEでモノルビを取得します。Text Services Framework(TSF)を利用して,文全体の読み仮名や,一つ一つの文字に対しての読み仮名を取得することができます。

※下のコードは今ひとつ不安定です。APIの定義が間違っているのかもしれません。









下のコードをフォームのコードにコピー・貼り付けをすれば動作します。
Option Explicit On
Option Strict On

Imports System.Runtime.InteropServices

Public Class Form1

    
Private WithEvents TextBox1 As New TextBox With {.Multiline = True, .Dock = DockStyle.Fill}
    
Private MsIme As Type = Type.GetTypeFromProgID("MSIME.Japan")
    
Private Language As IFELanguage = DirectCast(Activator.CreateInstance(MsIme), IFELanguage)

    
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        
Me.Controls.Add(TextBox1)
        Language.Open()
        
Dim KanjiText As String = "天気予報によると,明日は晴れになるでしょう。"
        
Dim List As List(Of kanjiRuby) = getMonoRuby(KanjiText)
        
For Each l In List
            
Me.TextBox1.Text &= l.kanji & "(" & l.ruby & ")" & vbCrLf
        
Next
        Language.Close()
        Marshal.FinalReleaseComObject(Language)
    
End Sub

    
Public Function getMonoRuby(kanjiSentence As StringAs List(Of kanjiRuby)
        
Dim resultPtr As IntPtr
        
Dim hr As Integer = Language.GetJMorphResult(FELANG_REQ.REV, FELANG_CMODE.MONORUBY, kanjiSentence.Length, kanjiSentence, 0, resultPtr)
        
Dim result As MORRSLT = DirectCast(Marshal.PtrToStructure(resultPtr, GetType(MORRSLT)), MORRSLT)
        
'MonoRubyPosをリストにコピーする
        
Dim length As Integer = kanjiSentence.Length
        
Dim kanjiRubyPosList = {New With {.kanji = "", .rubyPos = 0}}.ToList
        kanjiRubyPosList.Clear()
        
For i As Integer = 0 To length
            
Dim kanji As String = If(i < length, kanjiSentence.Substring(i, 1), "")
            
Dim rubyPos As Integer = CInt(Marshal.ReadInt16(result.paMonoRubyPos, i * 2))
            kanjiRubyPosList.Add(
New With {kanji, rubyPos})
        
Next
        
'熟字訓をまとめる
        
For i As Integer = length To 0 Step -1
            
If kanjiRubyPosList(i).rubyPos = -1 Then
                kanjiRubyPosList(i - 1).kanji &= kanjiRubyPosList(i).kanji
                kanjiRubyPosList.Remove(kanjiRubyPosList(i))
            
End If
        
Next
        
'モノルビをふる
        
Dim rubySentence As String = Marshal.PtrToStringUni(result.pwchOutput, CInt(result.cchOutput))
        
Dim kanjiRubyList As New List(Of kanjiRuby)
        
For i As Integer = 0 To kanjiRubyPosList.Count - 2
            
Dim kanji As String = kanjiRubyPosList(i).kanji
            
Dim rubyStartPos As Integer = kanjiRubyPosList(i).rubyPos
            
Dim rubyEndPos As Integer = kanjiRubyPosList(i + 1).rubyPos
            
Dim rubyLength As Integer = rubyEndPos - rubyStartPos
            
Dim ruby As String = rubySentence.Substring(rubyStartPos, rubyLength)
            kanjiRubyList.Add(
New kanjiRuby With {.kanji = kanji, .ruby = ruby})
        
Next
        
Return kanjiRubyList
    
End Function

    
Public Class kanjiRuby
        
Property kanji As String
        
Property ruby As String
    
End Class

End Class

'参考
'msime.h ダウンロード
'https://www.microsoft.com/en-us/download/details.aspx?id=9739
'IFELanguage::GetJMorphResult method
'https://msdn.microsoft.com/ja-jp/library/windows/desktop/hh851782(v=vs.85).aspx
'searchcode imelib /ImeLibSrc/WinApi/MsIme.cs 
'https://searchcode.com/codesearch/view/10960462/

Public NotInheritable Class Interface_ID
    
Public Const IID_IFECommon As String = "019F7151-E6DB-11d0-83C3-00C04FDDB82E"
    
Public Const IID_IFELanguage As String = "019F7152-E6DB-11d0-83C3-00C04FDDB82E"
    
Public Const IID_IFELanguage2 As String = "21164102-C24A-11d1-851A-00C04FCC6B14"
    
Public Const IID_IFEDictionary As String = "019F7153-E6DB-11d0-83C3-00C04FDDB82E"
End Class

<ComImport>
<Guid(Interface_ID.IID_IFELanguage)>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IFELanguage
    <PreserveSig>
    
Function Open() As Integer
    <PreserveSig>
    
Function Close() As Integer
    <PreserveSig>
    
Function GetJMorphResult(<[In]> dwRequest As FELANG_REQ,                                'The conversion request.
                             <[In]> dwCMode 
As FELANG_CMODE,                                'Specifies the conversion output characters and conversion options.
                             <[In]> cwchInput 
As Integer,                                   'The number of characters in pwchInput.
                             <[In], MarshalAs(UnmanagedType.LPWStr)> pwchInput 
As String,   'Input characters to be converted by the morphology engine. This must be a UNICODE string.
                             <[In]> 
ByRef pfCInfo As FELANG_CLMN,                           'The information for each column, where each pfCInfo[x] corresponds to pwchInput[x].
                             <Out> 
ByRef ppResult As IntPtr) As Integer                     'The address of a MORRSLT structure that receives the morphology result data.
    <PreserveSig>
    
Function GetConversionModeCaps(<Out> ByRef pdwCaps As UIntegerAs Integer
    <PreserveSig>
    
Function GetPhonetic(<[In]> [string] As String,
                         <[In]> start 
As Integer,
                         <[In]> length 
As Integer,
                         <Out> 
ByRef phonetic As StringAs Integer
    <PreserveSig>
    
Function GetConversion(<[In], MarshalAs(UnmanagedType.BStr)> [string] As String,
                           <[In]> start 
As Integer,
                           <[In]> length 
As Integer,
                           <Out> 
ByRef result As StringAs Integer
End Interface

Public Enum FELANG_REQ As UInteger
    CONV = &H10000
    RECONV = &H20000
    REV = &H30000
End Enum

Public Enum FELANG_CLMN As UInteger
    WBREAK = &H1
    NOWBREAK = &H2
    PBREAK = &H4
    NOPBREAK = &H8
    FIXR = &H10
    FIXD = &H20                     
'fix display of word
End Enum

Public Enum FELANG_CMODE As UInteger
    MONORUBY = &H2                  
'mono-ruby
    NOPRUNING = &H4                 
'no pruning
    KATAKANAOUT = &H8               
'katakana output
    HIRAGANAOUT = &H0               
'default output
    HALFWIDTHOUT = &H10             
'half-width output
    FULLWIDTHOUT = &H20             
'full-width output
    BOPOMOFO = &H40                 
'
    HANGUL = &H80                   

    PINYIN = &H100                  

    PRECONV = &H200                 
'do conversion as follows:
    RADICAL = &H400                 
'
    UNKNOWNREADING = &H800          
'
    MERGECAND = &H1000              
'merge display with same candidate
    ROMAN = &H2000                  
'
    BESTFIRST = &H4000              
'only make 1st best
    USENOREVWORDS = &H8000          
'use invalid revword on REV/RECONV.
    NONE = &H1000000                
'IME_SMODE_NONE
    PLAURALCLAUSE = &H2000000       
'IME_SMODE_PLAURALCLAUSE
    SINGLECONVERT = &H4000000       
'IME_SMODE_SINGLECONVERT
    AUTOMATIC = &H8000000           
'IME_SMODE_AUTOMATIC
    PHRASEPREDICT = &H10000000      
'IME_SMODE_PHRASEPREDICT
    CONVERSATION = &H20000000       
'IME_SMODE_CONVERSATION
    NAME = PHRASEPREDICT            
'Name mode (MSKKIME)
    NOINVISIBLECHAR = &H40000000    
'remove invisible chars (e.g. tone mark)
End Enum

<StructLayout(LayoutKind.Explicit, Size:=48, Pack:=1)>
Public Structure MORRSLT
    <FieldOffset(0)> 
Public dwSize As UInt32           'DWORD dwSize;          total size of this block.
    <FieldOffset(4)> 
Public pwchOutput As IntPtr       'WCHAR *pwchOutput;     conversion result string.
    <FieldOffset(8)> 
Public cchOutput As UInt16        'WORD  cchOutput;       lengh of result string.    
    <FieldOffset(10)> 
Public pwchRead As IntPtr        'union {WCHAR *pwchRead;WCHAR *pwchRead;} reading string
    <FieldOffset(14)> 
Public cchRead As UInt16         'union {WORD cchRead;WORD cchComp;} length of reading string.
    <FieldOffset(16)> 
Public pchInputPos As IntPtr     'WORD  *pchInputPos;    index array of reading to input character.
    <FieldOffset(20)> 
Public pchOutPutIdxWDD As IntPtr 'WORD  *pchOutputIdxWDD;index array of output character to WDD
    <FieldOffset(24)> 
Public pchReadIdxWDD As IntPtr   'union {WORD *pchReadIdxWDD;WORD  *pchCompIdxWDD;} index array of reading character to WDD
    <FieldOffset(28)> 
Public paMonoRubyPos As IntPtr   'WORD  *paMonoRubyPos;  array of position of monoruby
    <FieldOffset(32)> 
Public pWDD As IntPtr            'WDD   *pWDD;           pointer to array of WDD
    <FieldOffset(36)> 
Public cWDD As Int32             'INT   cWDD;            number of WDD
    <FieldOffset(40)> 
Public pPrivate As IntPtr        'VOID  *pPrivate;       pointer of private data area
    <FieldOffset(44)> 
Public BLKBuff As IntPtr         'WCHAR BLKBuff[];       area for stored above members.
End Structure

''64bitの定義
'<StructLayout(LayoutKind.Explicit, Size:=84, Pack:=1)>
'Public Structure MORRSLT
'    <FieldOffset(0)> Public dwSize As UInt32           'DWORD dwSize;          total size of this block.
'    <FieldOffset(4)> Public pwchOutput As IntPtr       'WCHAR *pwchOutput;     conversion result string.
'    <FieldOffset(12)> Public cchOutput As UInt16       'WORD  cchOutput;       lengh of result string.    
'    <FieldOffset(14)> Public pwchRead As IntPtr        'union {WCHAR *pwchRead;WCHAR *pwchRead;} reading string
'    <FieldOffset(22)> Public cchRead As UInt16         'union {WORD cchRead;WORD cchComp;} length of reading string.
'    <FieldOffset(24)> Public pchInputPos As IntPtr     'WORD  *pchInputPos;    index array of reading to input character.
'    <FieldOffset(32)> Public pchOutPutIdxWDD As IntPtr 'WORD  *pchOutputIdxWDD;index array of output character to WDD
'    <FieldOffset(40)> Public pchReadIdxWDD As IntPtr   'union {WORD *pchReadIdxWDD;WORD  *pchCompIdxWDD;} index array of reading character to WDD
'    <FieldOffset(48)> Public paMonoRubyPos As IntPtr   'WORD  *paMonoRubyPos;  array of position of monoruby
'    <FieldOffset(56)> Public pWDD As IntPtr            'WDD   *pWDD;           pointer to array of WDD
'    <FieldOffset(64)> Public cWDD As Int32             'INT   cWDD;            number of WDD
'    <FieldOffset(68)> Public pPrivate As IntPtr        'VOID  *pPrivate;       pointer of private data area
'    <FieldOffset(76)> Public BLKBuff As IntPtr         'WCHAR BLKBuff[];       area for stored above members.
'End Structure

19:12 | コメント(0)
1234
メニュー