Jeans & Development コンピューターのことなどを綴ったメモ (旧：目から鱗 w/SQLite)

（←戻る）
　前回までの記事で、ユーザー定義型の構造体を引数に持つWinAPIを呼び出せるようになった。引き続き、VBで出来た『Hello, World!』プログラムを見てみよう。

Option Explicit
Type POINTAPI
        x As Long
        y As Long
End Type

前回詰まったここの部分は、解決した。続きは…

Const SW_SHOW = 5
（略）
Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
    (ByVal hInstance As Long, ByVal lpIconName As String) As Long
（略）
Private g_chAppName As String
Private g_chClassName As String
Private p_hInstance As Long, p_hPreInst As Long
Private p_pchCmdLine As String, p_iCmdShow As Integer

ここまでは問題なし。Main()関数を見てみる。

Sub Main()
    'WinMainと互換性を持たせるための記述
    p_hInstance = App.hInstance
    p_hPreInst = App.PrevInstance
    p_pchCmdLine = Command
    p_iCmdShow = SW_SHOW
    
    g_chAppName = "TestApplication" 'アプリケーションの名前
    g_chClassName = "TestWndClass" 'ウィンドウクラス名

    If InitApplication(p_hInstance, AddressOf WndProc) = True Then

一番大きな問題はこの行にある。VBscriptでは、『AddressOf 』は使えない。

　『AddressOf 』が使えないというよりも、コールバック関数を使うのが無理ではないかと思われる。もともと『AddressOf 』はVBが完全なコンパイラ（ネイティブコードにコンパイルされる）になったVer5からの機能で、Ver4以前には無かったものである。VBscriptでは、ネイティブコードにコンパイルされて実行されるのではなく、Ver4以前のVBに近い形のインタプリタの形式で実行している様に思われる。

　スクリプトの中でなにかしらの関数を定義した場合、その関数がJavaのJITの様にコンパイルされてメモリに格納されている可能性はある。ただ、そういった場合でもVBscriptはデータ型がバリアント型のみであるので、コールバック関数の規定の型にはめられるように定義することは無理であろう。やはり、コールバック関数は自作DLLの中に用意するしかない。今回製作した自作DLLの中のコールバック関数に関連する部分は次の通りである。

long __stdcall DwWndProc( HWND hWnd, UINT uiMsg, WPARAM wParam, LPARAM lParam )
{
    return DefWindowProc( hWnd, uiMsg, wParam, lParam );
}
long __stdcall DwAddressOfWndProc()
{
    return DwWndProc;
}

プロトタイプでは、WndProcの中では何もせずDefWindowProcを呼び出すだけにした（ここの部分が一番重要なのであるが、その対処は次回以降に考えることにしたい）。また、このWndProcのアドレスを与えるDwAddressOfWndProcを用意した。

　この機能に対応させて作成したtest.vbsは以下の通りである。

option explicit
Dim UserWrap
Set UserWrap = CreateObject("DynamicWrapper")
UserWrap.Register "debug\dwtools.dll", "Test", "I=l", "f=s", "R=l"
UserWrap.Register "debug\dwtools.dll", "DwGetAddressOfString", "I=su", "f=s", "R=l"
UserWrap.Register "debug\dwtools.dll", "DwClearBuffer",  "f=s"
UserWrap.Register "debug\dwtools.dll", "DwCopyLong", "I=ll", "f=s", "R=l"
UserWrap.Register "debug\dwtools.dll", "DwAddressOfWndProc", "f=s", "R=l"

UserWrap.Register "user32.dll", "UnregisterClassA", "I=sl", "f=s", "R=l"
UserWrap.Register "user32.dll", "RegisterClassExA", "I=l", "f=s","R=t"
UserWrap.Register "user32.dll", "CreateWindowExA", "I=lsslllllllll", "f=s","R=l"
UserWrap.Register "user32.dll", "ShowWindow", "I=ll", "f=s","R=l"
UserWrap.Register "user32.dll", "UpdateWindow", "I=l", "f=s","R=l"
UserWrap.Register "user32.dll", "GetMessageA", "I=llll", "f=s","R=l"
UserWrap.Register "user32.dll", "TranslateMessage", "I=l", "f=s","R=l"
UserWrap.Register "user32.dll", "DispatchMessage", "I=l", "f=s","R=l"

Const SW_SHOW = 5
Const CS_BYTEALIGNWINDOW = &H2000
Const CS_HREDRAW = &H2
Const CS_VREDRAW = &H1
Const COLOR_BACKGROUND = 1
Const WS_OVERLAPPEDWINDOW = &HCF0000
Const CW_USEDEFAULT = &H80000000
Const WM_PAINT = &HF
Const WM_DESTROY = &H2
Const IMAGE_ICON = 1
Const LR_DEFAULTCOLOR = &H0


Dim g_chAppName, g_chClassName
Dim p_hInstance, p_hPreInst, p_pchCmdLine, p_iCmdShow

Call Main
Wscript.quit

Sub Main()
  p_hInstance = 0
  p_pchCmdLine = ""
  p_iCmdShow = SW_SHOW

  g_chAppName = "TestApplication" 'アプリケーションの名前
  g_chClassName = "TestWndClass" 'ウィンドウクラス名
  If InitApplication(p_hInstance, UserWrap.DwAddressOfWndProc) = True Then
    If InitInstance(p_hInstance, p_iCmdShow) = True Then
      Call Run
    End If
    Call UserWrap.UnregisterClassA(g_chClassName, p_hInstance)
  End If

End Sub

'ウィンドウクラス
Class WNDCLASSEX
  public cbSize ' As Long
  public style ' As Long
  public lpfnWndProc ' As Long
  public cbClsExtra ' As Long
  public cbWndExtra ' As Long
  public hInstance ' As Long
  public hIcon ' As Long
  public hCursor ' As Long
  public hbrBackground ' As Long
  public lpszMenuName ' As String
  public lpszClassName ' As String
  public hIconSm ' As Long

  Public Function Structure()
    UserWrap.DwClearBuffer
    Structure=UserWrap.DwGetAddressOfString("",48) 'Length of structure is 48
    UserWrap.DwCopyLong cbSize, Structure ' As Long
    UserWrap.DwCopyLong style, Structure+4 ' As Long
    UserWrap.DwCopyLong lpfnWndProc, Structure+8 ' As Long
    UserWrap.DwCopyLong cbClsExtra, Structure+12 ' As Long
    UserWrap.DwCopyLong cbWndExtra, Structure+16 ' As Long
    UserWrap.DwCopyLong hInstance, Structure+20 ' As Long
    UserWrap.DwCopyLong hIcon, Structure+24 ' As Long
    UserWrap.DwCopyLong hCursor, Structure+28 ' As Long
    UserWrap.DwCopyLong hbrBackground, Structure+32 ' As Long
    UserWrap.DwCopyLong StrAddress(lpszMenuName), Structure+36 ' As String
    UserWrap.DwCopyLong StrAddress(lpszClassName), Structure+40 ' As String
    UserWrap.DwCopyLong hIconSm, Structure+44 ' As Long
  End Function

  Private Function StrAddress(str)
    Select Case VarType(str)
    Case vbString
      StrAddress=UserWrap.DwGetAddressOfString(str+"",0)
    Case Else
      StrAddress=0 'return Null string
    End Select
  End Function
End Class

'ウィンドウクラスを登録
Function InitApplication(p_hInstance, AddressOfWndProc ) 
    Dim stWndClass
    Set stWndClass=New WNDCLASSEX 'ウィンドウクラス
    
    Call UserWrap.UnregisterClassA(g_chClassName+"", p_hInstance)
    
    stWndClass.cbSize = 48
    stWndClass.style = CS_BYTEALIGNWINDOW Or CS_HREDRAW Or CS_VREDRAW
    stWndClass.lpfnWndProc = AddressOfWndProc
    stWndClass.cbClsExtra = 0
    stWndClass.cbWndExtra = 0
    stWndClass.hInstance = p_hInstance
    stWndClass.hIcon = 0
    stWndClass.hCursor = 0
    stWndClass.hbrBackground = COLOR_BACKGROUND
    stWndClass.lpszMenuName = ""
    stWndClass.lpszClassName = g_chClassName
    stWndClass.hIconSm = 0

    If UserWrap.RegisterClassExA(stWndClass.Structure) Then
        InitApplication=True
    Else
        InitApplication=False
    End If

End Function

'ウィンドウの表示
Function InitInstance(p_hInstance, p_nCmdShow)
    Dim hWnd 'ウィンドウハンドル

    'ウィンドウを作製
    hWnd = UserWrap.CreateWindowExA(0, g_chClassName+"", g_chAppName+"", _
        WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, 0, 200, 100, 0, 0, _
        p_hInstance, 0)

    'ウィンドウを表示
    Call UserWrap.ShowWindow(hWnd, p_nCmdShow)
    Call UserWrap.UpdateWindow(hWnd)
    If hWnd = 0 Then
        InitInstance = False
    Else
        InitInstance = True
    End If
End Function

'メッセージループ
Function Run()
    'MSG構造体
    Dim stMsg
    UserWrap.DwClearBuffer
    stMsg=UserWrap.DwGetAddressOfString("",28) 'Length of MSG is 28

    'メッセージを送る
    Do While (UserWrap.GetMessageA(stMsg, 0, 0, 0))
        Call UserWrap.TranslateMessage(stMsg)
        Call UserWrap.DispatchMessage(stMsg)
    Loop
    'Run = stMsg.wParam
End Function

このソースコードは見ての通り、最初に紹介したVB用の『Hello, World!』プログラムと殆ど同じになった。唯一違うのは、コールバック関数が含まれていない点である。実行結果は次のようになる。



残るは、コールバック関数の処理のみ。

（続く）