「Any型」の追放に成功した

Any型の追放に成功した

akashi-keirin.hatenablog.com

これの続報。

この記事には、id:imihito さんからコメントをいただいていた。

曰く、

記事の
`Call MoveMemory(lpMemory, VarPtr(strText), lngSize)`
に関しては`VatPtr`を`StrPtr`にするとどうなるでしょうか?

と。

そもそもStrPtrというものを知らなかった。

で、やってみた。

API関数の宣言部の書き換え

問題のAPI関数は、次のもの。

Private Declare Sub MoveMemory Lib "kernel32" _
                      Alias "RtlMoveMemory" _
                      (ByVal lpDest As Any, _
                       ByVal lpSource As Any, _
                       ByVal Length As Long)

メモリの書き込み先と、書き込み元のメモリアドレスの指定っぽい第1・2引数がナゾのAny型指定になっている。こいつらを、Long型に変える。

Private Declare Sub MoveMemory Lib "kernel32" _
                      Alias "RtlMoveMemory" _
                      (ByVal lpDest As Long, _
                       ByVal lpSource As Long, _
                       ByVal Length As Long)

呼び出し側コードの修正

そして、ClipboardクラスのsetTextgetTextメソッド内で、MoveMemory関数を呼び出している部分のコードを修正する。

リスト1 クラスモジュール
'setTextメソッド内'
Call MoveMemory(lpDest:=pointerOfMemory, _
                lpSource:=StrPtr(targetText), _
                Length:=sizeOfText)

第2引数lpSourceString型の変数targetTextを渡していたのを、StrPtr(targetText)に改めた。

スト2 クラスモジュール
'getTextメソッド内'
Call MoveMemory(lpDest:=StrPtr(targetText), _
                lpSource:=pointerOfMemory, _
                Length:=sizeOfText)

こちらは、

第1引数lpDestString型の変数targetTextを渡していたのを、StrPtr(targetText)に改めた。

いづれも、Any型指定でString型引数を渡していたのをLong型に改めたことになる。

実行

次のコードで実行。

リスト3 標準モジュール
Public Sub test()
  Dim clpBoard As New Clipboard
  With clpBoard
    Call .setText("ち~んw")
    Debug.Print .getText
  End With
End Sub

Clipboardクラスのインスタンスを作成し、setTextメソッドによってクリップボードに「ち~んw」と書き込み、getTextメソッドでその「ち~んw」を取り出してイミディエイト・ウインドウに出力するだけのコード。

実行結果

f:id:akashi_keirin:20190323095949j:plain

おお! 動いた!

おわりに

ちなみに、StrPtrではなく、VarPtrにすると、

f:id:akashi_keirin:20190323095952j:plain

このようにエラーとなり、そのまま終了すると、クリップボードが使えなくなる。

StrPtrに戻して一度実行すると復活しましたが、ヒヤリとしましたw