VB.NETでマシン語を使う3
2005年12月16日
VB.NET版DynaCallが完成した。次のようなvbscriptのコードで、MessageBoxAが呼び出せる。
実行結果は、前の記事と同じで以下の通り。
パラメータをクラスのPush関数で与え、戻り値はクラスのeax, edxプロパティで取得するようにした。この辺りは、アセンブラの仕様を残してある。ソースは、以下の通り。
ここからダウンロードできます。
set dc=CreateObject("dwtools.NET.dynacall") dc.Push 1 dc.Push dc.AnsiString("テスト") dc.Push dc.AnsiString("DynaCall.NET") dc.Push 0 call dc.CallAPI("user32","MessageBoxA")
実行結果は、前の記事と同じで以下の通り。
パラメータをクラスのPush関数で与え、戻り値はクラスのeax, edxプロパティで取得するようにした。この辺りは、アセンブラの仕様を残してある。ソースは、以下の通り。
option strict on Imports System Imports System.Runtime.InteropServices Imports Microsoft.VisualBasic Namespace dwtools.NET public class DynaCall 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 Declare Function GetLastError Lib "kernel32" () As Integer Private DllFiles() as string, hDlls() as integer Private DllFileNum as integer=0 'stack preparation Public eax as integer, edx as integer Public Stack() as integer Private StackNum as integer=0 Public Sub PopAll() StackNum=0 AnsiStringNum=0 Redim Stack(-1) Redim AnsiStringObj(-1) End Sub Public Sub Push(i as integer) Redim Preserve Stack(StackNum) Stack(StackNum)=i StackNum=StackNum+1 End Sub Public LastError as integer Private Function WithError() as boolean LastError=GetLastError() return false End Function Public Function CallAPI(ByVal lpFileName as string, ByVal lpProcName as string) as boolean lpFileName=lcase(lpFileName) if right(lpFileName,4)=".dll" then lpFileName=left(lpFileName,len(lpFileName)-4) 'Load DLL and resolve Proc Address Dim i as integer Dim hDll as integer=0 Dim ProcAddress as integer=0 for i=0 to DllFileNum if i=DllFileNum then 'when not found hDll=LoadLibrary(lpFileName) if hDll=0 then return WithError() Redim Preserve DllFiles(DllFileNum), hDlls(DllFileNum) DllFiles(DllFileNum)=lpFileName hDlls(DllFileNum)=hDll DllFileNum=DllFileNum+1 exit for elseif DllFiles(i)=lpFileName then hDll=hDlls(i) exit for end if next i ProcAddress=GetProcAddress(hDll,lpProcName) if ProcAddress=0 then return WithError() 'Prepare buffer for getting return code from API Dim Res(1) as integer Dim gch as GCHandle=GCHandle.Alloc(Res, GCHandleType.Pinned) 'Call the machine code through EnumWindws EnumWindows(TheCode(Stack,gch.AddrOfPinnedObject().ToInt32()),ProcAddress) eax=Res(0) edx=Res(1) gch.free() PopAll() return true End Function 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=0 to Params.Length-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 'Make a buffer and keep ANSI string in it Private AnsiStringObj() as AnsiStringClass Private AnsiStringNum as integer=0 Public Function AnsiString(T as string) as integer Redim Preserve AnsiStringObj(AnsiStringNum) AnsiStringObj(AnsiStringNum)=new AnsiStringClass(T) AnsiString=AnsiStringObj(AnsiStringNum).address AnsiStringNum=AnsiStringNum+1 End Function Private Class AnsiStringClass 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)=cByte(b) buffLen=buffLen+1 else 'Two byte code if b<0 then b=b+65536 Redim Preserve buff(buffLen+1) buff(buffLen)=cByte(b \ 256) buff(buffLen+1)=cByte(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() as integer Return gch.AddrOfPinnedObject().ToInt32() End Function Protected Overrides Sub Finalize() On error resume next gch.Free() end sub End Class 'AnsiString End Class 'DynaCall End Namespace 'dwtools.NET
ここからダウンロードできます。