八寿のナレッジベース

この文書は読取専用です。文書のソースを閲覧することは可能ですが、変更はできません。もし変更したい場合は管理者に連絡してください。
====== vb2clr ======
Excelから.NET Framework 4.xの機能を使用できるツール\\
https://github.com/jet2jet/vb2clr

===== 使い方 =====
ExitHandler.bas と CLRHost.cls ファイルをプロジェクトにドラッグ＆ドロップする。\\
{{:it技術:vbproject.png|}}

=== 補足 ===
vb2clrは日本人の方が開発しており、Excel関連ファイルはShift-JISを用いている。\\
そのため、海外向けにUTF-8用に変換されたファイルが用意されている。
  * ExitHandler.utf8.bas
  * CLRHost.utf8.cls

==== 参照設定 ====
「Common Runtime Language Execution Engine」と「mscorlib.dll」を参照する。

{{:it技術:参照設定.png|}}

==== 公開キートークン ====
.NET Frameworkのライブラリーを使用するのに、公開キートークンを知る必要がある。

=== 調べ方 ===
[[https://devlights.hatenablog.com/entry/20130827/p1|公開キートークン(Public Key Token)の調べ方 (厳密名ツール, SN.exeを利用)]]

VS 2022用開発者コマンドプロンプトを起動します。\\
ネイティブx64バージョン（[ x64 Native Tools Command Prompt for VS 2022 ] ）を選択してください。

例として、「System.dll」を調べます。

<code>
cd "C:\Windows\Microsoft.NET\Framework64\v4.0.30319"

C:\Windows\Microsoft.NET\Framework64\v4.0.30319>SN.exe -T "System.dll"

Microsoft(R) .NET Framework Strong Name Utility バージョン 4.0.30319.0
Copyright (c) Microsoft Corporation. All rights reserved.

公開キー トークン b77a5c561934e089
</code>

=== よく使用するもの ====
アセンブリにより同じPublicKeyTokenを使用している。

^System.Collections|System.Collections, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a|
^System.IO|System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a|
^System.Text.Encoding|System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a|
^System.Drawing|System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a|
^System|System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089|
^System.IO.Compression.FileSystem|System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089|

=== どのアセンブリを使っているのか ===
例えば、「System.Security.Cryptography.SHA256Managed」は、どのdllなのか？

マイクロソフトのサイトで検索、バージョンを「.NET Framework 4.8.1」を指定する。
SHA256Managed クラスにアセンブリ:mscorlib.dll と記載されている。\\
https://learn.microsoft.com/ja-jp/dotnet/api/system.security.cryptography.sha256managed?view=netframework-4.8.1

<code>
SN.exe -T "mscorlib.dll"
公開キー トークン b77a5c561934e089
</code>

System.dll と同じなので、下記を使用すればよい。
<code>
Dim Assem As mscorlib.Assembly
host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
</code>

===== サンプル =====
https://club.excelhome.net/thread-1692104-1-1.html

==== StringBuilderのテスト ====
<code vb>
Sub StringbuildTest()
    Dim host As New CLRHost

    Call host.Initialize(False)

    Dim Assem As mscorlib.Assembly, sb As mscorlib.Object, r As Variant
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")

    Set sb = host.ToObject(host.CLRCreateObject("System.Text.StringBuilder"))
    Set sb = host.CLRInvokeMethod(sb, "Append", "The quick brown fox jumped over the lazy dog. ")
    Set sb = host.CLRInvokeMethod(sb, "Append", "Mary had a little lamb.")

    Debug.Print host.CLRProperty(sb, "Length")
    r = host.CLRInvokeMethod(sb, "ToString")
    Debug.Print r

    Set sb = Nothing
    Set host = Nothing
End Sub
</code>

==== SortedListとArrayListのテスト ====
<code vb>
Sub SortedlistTest()
    Dim host As New CLRHost

    Call host.Initialize(False)

    Dim Assem As mscorlib.Assembly, mySL As Object, Total%, i%, aList As Object, interfacelist As Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set Assem = host.CLRLoadAssembly("System.Collections, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    Set mySL = host.ToObject(host.CLRCreateObject("System.Collections.SortedList"))

    mySL.Add "Third", "!"
    mySL.Add "Second", "World"
    mySL.Add "First", "Hello"

    Total = mySL.Count
    Debug.Print "番号：", Total

    For i = 0 To Total - 1
        Debug.Print mySL.GetKey(i), mySL.GetByIndex(i)
    Next

    Set mySL = Nothing
    Stop

    Set aList = host.ToObject(host.CLRCreateObject("System.Collections.ArrayList"))
    aList.Add ("Hello")
    aList.Add ("World")
    aList.Add ("!")

    For Each key In aList
        Debug.Print key
    Next key

    Debug.Print aList.IndexOf("!", 0)
    Set aList = Nothing
    Set host = Nothing
End Sub
</code>

==== 乱数テスト ====
<code vb>
Sub RandomTest()
    Dim host As New CLRHost, dic As Object, s As Long, key As Variant
    Dim objRandom As mscorlib.Object, asmSys As mscorlib.Assembly

    Call host.Initialize(False)
    Set dic = CreateObject("scripting.dictionary")
    Set asmSys = host.CLRLoadAssembly("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set objRandom = host.CLRCreateObject("System.Random")
    
    ' 使用「System.Random.Next(Int32, Int32)」
    ' 10個の重複しない乱数を生成する
    Do
        s = host.CLRInvokeMethod(objRandom, "Next")
        If Not dic.Exists(s) Then dic.Add s, ""
    Loop Until dic.Count >= 10

    ' 乱数の出力
    For Each key In dic.Keys
        Debug.Print key
    Next key

    Set dic = Nothing
    Set objRandom = Nothing
    Set host = Nothing
End Sub
</code>

==== テキストファイルの書込み ====
<code vb>
Sub filetext() 
    ' テキストを書く
    Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, createText$
    Call host.Initialize(False)

    'On Error Resume Next

    Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, writer As mscorlib.Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")

    Set SW = host.CLRResolveType("System.IO.Stream")
    Set Encoding = host.CLRResolveType("System.Text.Encoding")
    Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)

    ' ※Excel ファイルが配置されているパス フォルダーは CDriveDirs.txt ファイルを生成し、BOM 付きの utf8 テキストを書き込みます。
    textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
    Set writer = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamWriter", False, _
    BindingFlags_Instance Or BindingFlags_Public Or BindingFlags_CreateInstance, Nothing, Array(textPath, False, utf8), Nothing, Array())

    ' 書き込むメッセージ
    createText = "Hello and Welcome, 温かい歓迎"
    host.CLRInvokeMethod writer, "Write", createText
    host.CLRInvokeMethod writer, "Close"

    Set SW = Nothing
    Set writer = Nothing
    Set Encoding = Nothing
    Set utf8 = Nothing
    Set host = Nothing
End Sub
</code>

==== テキストファイルの読込み ====
<code vb>
Sub filetextReader() 
    ' テキストを読む
    Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, readText$

    Call host.Initialize(False)

    'On Error Resume Next

    Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, reader As mscorlib.Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")

    textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
    If Len(Dir(textPath)) = 0 Then MsgBox "上記のテキスト書き込み操作を実行し、その後テキストを読み取ります": GoTo label:

    Set SW = host.CLRResolveType("System.IO.Stream")
    Set Encoding = host.CLRResolveType("System.Text.Encoding")
    Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)
    Set reader = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamReader", False, _
    BindingFlags_Public Or BindingFlags_Instance Or BindingFlags_CreateInstance, Nothing, Array(textPath, utf8), Nothing, Array())

    readText = host.CLRInvokeMethod(reader, "ReadToEnd")
    host.CLRInvokeMethod reader, "Close"

    Debug.Print readText

label:
    Set SW = Nothing
    Set reader = Nothing
    Set Encoding = Nothing
    Set utf8 = Nothing
    Set host = Nothing
End Sub
</code>

==== emfファイルをpngファイルに変換 ====
<code vb>
Sub test1()
   ' emfファイルは「拡張メタファイル」と呼ばれる形式です。
   ' Windows のドロー形式（図形の集合で表す）の画像で、一般に引き伸ばしても粗くなりません。
    Dim host As New CLRHost, inputFile$, outputFile$

    Call host.Initialize(False)
    inputFile = ThisWorkbook.Path & "\1.emf"
    outputFile = ThisWorkbook.Path & "\1.png"

    On Error Resume Next

    Dim asmSys As mscorlib.Assembly
    Set asmSys = host.CLRLoadAssembly("System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    Dim imgclass As mscorlib.Object, img As mscorlib.Object, fmt As mscorlib.Object, png As mscorlib.Object
    Set imgclass = host.CLRResolveType("System.Drawing.Image")

    ' emfファイルの高さと幅を出力
    Set img = host.CLRInvokeStaticMethod(imgclass, "FromFile", inputFile)
    Debug.Print "ピクチャの高さ: "; host.CLRProperty(img, "Height"); "ピクチャの幅:"; host.CLRProperty(img, "Width")

    ' emfファイルをpngファイルに変換して保存する
    Set fmt = host.CLRResolveType("System.Drawing.Imaging.ImageFormat")
    Set png = host.CLRInvokeMethod(host.CLRInvokeMethod(fmt, "GetProperty", "Png"), "GetValue", Null)
    host.CLRInvokeMethod img, "Save", outputFile, png

    Set imgclass = Nothing
    Set img = Nothing
    Set fmt = Nothing
    Set png = Nothing
    Set host = Nothing
End Sub
</code>

==== ZIP内のファイル一覧取得 ====
<code vb>
Sub ZIPList()
    ' 圧縮パッケージリストを取得する
    ' System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089

    Dim host As New CLRHost, zipfilepath As String
    Call host.Initialize(False)

    'On Error Resume Next

    Dim asmSys As mscorlib.Assembly, ZipFile As mscorlib.Object, archive As mscorlib.Object, Entries As Variant, entry As Variant
    Set asmSys = host.CLRLoadAssembly("System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set ZipFile = host.CLRResolveType("System.IO.Compression.ZipFile")

    ' zipファイルの存在確認
    zipfilepath = "C:\Users\Administrator\Downloads\Compressed\pcre2-10.43.zip"
    If Len(Dir(zipfilepath)) = 0 Then MsgBox "パス内のzipファイルが存在しません": Exit Sub

    ' zipファイルの読込み
    Set archive = host.CLRInvokeStaticMethod(ZipFile, "OpenRead", zipfilepath)
    Set Entries = host.ToEnumerable(host.CLRProperty(archive, "Entries"))
    For Each entry In Entries
        ' zipファイル内の各ファイルのフルパス名を出力
        Debug.Print host.CLRProperty(entry, "FullName")
    Next

    Set archive = Nothing
    Set ZipFile = Nothing
    Set host = Nothing
End Sub
</code>

==== SHAハッシュの取得 ====
<code vb>
Private Sub ComputeSHATest()
    
    Debug.Print "SHA256"
    Debug.Print GetSHA256(Range("A1"))

    Debug.Print "SHA384"
    Debug.Print GetSHA384(Range("A1"))
    
    Debug.Print "SHA512"
    Debug.Print GetSHA512(Range("A1"))
End Sub
</code>

<code text 結果>
' A1セルに"Hello World"をセット
SHA256
a591a6d40bf420404a011733cfb7b190d62c65bf0bcda32b57b277d9ad9f146e
SHA384
99514329186b2f6ae4a1329e7ee6c610a729636335174ac6b740f9028396fcc803d0e93863a7c3d90f86beee782f4f3f
SHA512
2c74fd17edafd80e8447b0d46741ee243b7eb74dd2149a0ab1b9246fb30382f27e853d8585719e0e67cbda0daa8f51671064615d645ae27acb15bfb1447f459b
</code>

RelaxTools-Addin のソースコードを元に書き換え、これを使うことで.NET Framweork 3.5のインストールが不要になる。\\
https://software.opensquare.net/relaxtools/archives/3892/

<code vb basFunction>
Option Explicit
Private Const C_SHA256 As Long = 1
Private Const C_SHA384 As Long = 2
Private Const C_SHA512 As Long = 3
'--------------------------------------------------------------
'　SHA256算出関数
'--------------------------------------------------------------
Public Function GetSHA256(ハッシュ値算出範囲 As Range) As Variant
    Application.Volatile
    GetSHA256 = ComputeSHA(C_SHA256, ハッシュ値算出範囲)

End Function
'--------------------------------------------------------------
'　SHA384算出関数
'--------------------------------------------------------------
Public Function GetSHA384(ハッシュ値算出範囲 As Range) As Variant
    Application.Volatile
    GetSHA384 = ComputeSHA(C_SHA384, ハッシュ値算出範囲)

End Function
'--------------------------------------------------------------
'　SHA2512算出関数
'--------------------------------------------------------------
Public Function GetSHA512(ハッシュ値算出範囲 As Range) As Variant
    Application.Volatile
    GetSHA512 = ComputeSHA(C_SHA512, ハッシュ値算出範囲)

End Function

Private Function ComputeSHA(lngType As Long, r As Range) As Variant

    Dim host As New CLRHost
    Call host.Initialize(False)
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    
    Dim str As String
    'Rangeの文字列結合（ワークシート関数のConcatを流用）
    str = Application.WorksheetFunction.Concat(r)
    
    'バイト読み込み
    Dim code() As Byte
    Dim objUTF8 As mscorlib.Object
    Set objUTF8 = host.ToObject(host.CLRCreateObject("System.Text.UTF8Encoding"))
    code = host.CLRInvokeMethod(objUTF8, "GetBytes", str)
    Set objUTF8 = Nothing
    
    'ハッシュ値計算
    Dim hashValue() As Byte
    Dim objSHA As mscorlib.Object
    Select Case lngType
        Case C_SHA256
            Set objSHA = host.ToObject(host.CLRCreateObject("System.Security.Cryptography.SHA256Managed"))
        Case C_SHA384
            Set objSHA = host.ToObject(host.CLRCreateObject("System.Security.Cryptography.SHA384Managed"))
        Case C_SHA512
            Set objSHA = host.ToObject(host.CLRCreateObject("System.Security.Cryptography.SHA512Managed"))
    End Select
    hashValue = host.CLRInvokeMethod(objSHA, "ComputeHash", code)
    Set objSHA = Nothing
    
    '16進数へ変換
    Dim description As String
    
    description = ""
    
    Dim i As Long
    For i = LBound(hashValue()) To UBound(hashValue())
        description = description & Right("0" & Hex(hashValue(i)), 2)
    Next i

    'return
    ComputeSHA = LCase(description)

    Set host = Nothing
End Function
</code>