電子ブロック工房 IC・トランジスタで出来たコンピューターを設計・製作するためのブログ

　VB.NETによるDynaCallの原型になるテストプログラムが完成した。テストでは、MessageBoxAを呼び出すことに成功している。

option explicit
Imports System
Imports System.Runtime.InteropServices
Imports Microsoft.VisualBasic

Module Main

  Declare Function EnumWindows Lib "user32" (x As Integer, y As Integer) As Integer
  Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Integer 
  Declare Function GetProcAddress  Lib "kernel32" Alias "GetProcAddress" (ByVal ModuleHandle As Integer, ByVal ProcName As String) As Integer
  Declare Function FreeLibrary Lib "kernel32" (ByVal hDll As Integer) As Integer

  Sub Main()
  
    'Load DLL and resolve Proc Address
    Dim hDll as integer =LoadLibrary("user32")
    Dim MessageBoxA as integer=GetProcAddress(hDll,"MessageBoxA")
    
    'Prepare buffer for getting return code from API
    Dim Res(1) as integer
    Dim gch as GCHandle=GCHandle.Alloc(Res, GCHandleType.Pinned)

    'Prepare the parameters
    dim Params(3) as integer
    Params(0)=0
    dim str1 as AnsiString=new AnsiString("DynaCall.NET")
    dim str2 as AnsiString=new AnsiString("テスト")
    Params(1)=str1.address
    Params(2)=str2.address
    Params(3)=vbOkCancel
    
    'Call the machine code through EnumWindws
    EnumWindows(TheCode(Params,gch.AddrOfPinnedObject().ToInt32()),MessageBoxA)
    Console.WriteLine("eax: "+hex(Res(0)))
    Console.WriteLine("edx: "+hex(Res(1)))
    
    FreeLibrary(hDll)
    
  End Sub
  
  private GchAsmCode as GCHandle
  private AsmCode() as byte
  private AsmCodeSize as integer
  Private Function TheCode(Params() as integer,AddrOfRes as integer) as integer
    Dim i as integer
    
    'Initialize buffer
    On error resume next
    GchAsmCode.free()
    On error goto 0
    AsmCodeSize=0
    
    AddByte(&H58)                   'pop       eax           //contains return address
    AddByte(&H58)                   'pop       eax           //contains hWnd
    AddByte(&H58)                   'pop       eax           //contains lParam (address of API)
    AddByte(&H83,&Hec,&H0c)         'sub       esp,0000000c  //return to original stack position
    for i=Params.Length-1 to 0 step -1
      AddByte(&H68)
      AddInt(Params(i))             'push      Params(i)     //create the stack for API
    next i
    AddByte(&Hff,&Hd0)              'call      eax           //call API
    AddByte(&Hbb):AddInt(AddrOfRes) 'mov       ebx,AddrOfRes
    AddByte(&H89,&H03)              'mov       [ebx],eax     //put the return code (eax)
    AddByte(&H89,&H53,&h04)         'mov       [ebx+4],edx   //put the return code (edx)
    AddByte(&H33,&Hc0)              'xor       eax,eax       //eax=0 (return code is 0)
    AddByte(&Hc2,&H08,&H00)         'ret       0008          //remove 8 bytes from stack and return
    GchAsmCode = GCHandle.Alloc(AsmCode, GCHandleType.Pinned)
    return GchAsmCode.AddrOfPinnedObject().ToInt32()
  End Function

  Private Sub AddByte(b1 as byte)
    Redim Preserve AsmCode(AsmCodeSize)
    AsmCode(AsmCodeSize)=b1
    AsmCodeSize=AsmCodeSize+1
  End Sub
  Private Sub AddByte(b1 as byte,b2 as byte)
    AddByte(b1)
    AddByte(b2)
  End Sub
  Private Sub AddByte(b1 as byte,b2 as byte,b3 as byte)
    AddByte(b1)
    AddByte(b2)
    AddByte(b3)
  End Sub
  Private Sub AddByte(b1 as byte,b2 as byte,b3 as byte,b4 as byte)
    AddByte(b1)
    AddByte(b2)
    AddByte(b3)
    AddByte(b4)
  End Sub
  Private Sub AddInt(i1 as integer)
    Dim T as string=right("00000000"+hex(i1),8)
    AddByte(cByte("&H"+mid(T,7,2)))
    AddByte(cByte("&H"+mid(T,5,2)))
    AddByte(cByte("&H"+mid(T,3,2)))
    AddByte(cByte("&H"+mid(T,1,2)))
  End Sub
  
  Private Class AnsiString
    Private gch as GCHandle
    Private buff(0) as byte
    Public Sub New(T as string)
      dim i as integer, b as integer
      dim buffLen as integer=0
      for i=1 to len(T)
        b=asc(mid(T,i,1))
        if 0<=b and b<=255 then
          Redim Preserve buff(buffLen)
          buff(buffLen)=b
          buffLen=buffLen+1
        else 
          if b<0 then b=b+65536
          Redim Preserve buff(buffLen+1)
          buff(buffLen)=b \ 256
          buff(buffLen+1)=b mod 256
          buffLen=buffLen+2
        end if
      next i
      Redim Preserve buff(buffLen)
      buff(buffLen)=0
      gch=GCHandle.Alloc(buff, GCHandleType.Pinned)
    End Sub
    Public Function Address()
      Return gch.AddrOfPinnedObject().ToInt32()
    End Function
    Protected Overrides Sub Finalize()
      On error resume next
      gch.Free()
    end sub
  End Class
  
End Module

実行結果は以下の通り



"OK"を押すと

eax: 1
edx: 1870001

"キャンセル"を押すと

eax: 2
edx: 1870001

の様にコンソールに出力される。