ab.com コミュニティ

コード: 全て選択

Dim id As DWord
Sub Thread(Param As VoidPtr)
	Dim msg As MSG
	Do
		PostThreadMessage(id,WM_APP,0,0)
		If PeekMessage(msg,0,0,0,PM_REMOVE)=TRUE Then Exit Do
		Sleep(0)
	Loop
	While GetMessage(msg,0,0,0)
		Select Case msg.message
			Case WM_USER+1
				MessageBeep(MB_ICONEXCLAMATION)
		End Select
	Wend
End Sub

コード: 全て選択

'-----------------------------------------------------------------------------
	'System Hookの開始用
	Declare Function StartHook Lib "GetStatusMK" (hWnd As DWord) As Long

	'System Hookの終了用
	Declare Function EndHook Lib "GetStatusMK" () As Long
'-----------------------------------------------------------------------------

[GetStatusMK.dll]

#include "GetStatusMK.idx"

'-------------------------------------------------------------------
' メモ - このファイルには、DLLの構成要素を記述します。
'        （例：関数定義、グローバル変数、定数定義など）
'
'        エクスポートが必要な関数には、"Export" 修飾子を指定します。
'        （例：Function Export FuncName() As Long）
'-------------------------------------------------------------------
	'フックをインストールする関数の宣言
	Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
					(idHook As DWord,_	  'インストールするフックの種類
					 lpfn As DWord,_		'インストールするフック関数のアドレス
					 hMod As DWord,_		'インスタンスハンドル
					 dwThreadId As DWord_   'カレントスレッドID
					) As DWord              '戻り値は、フックハンドル

	'フックをアンインストールする関数の宣言
	Declare Function UnhookWindowsHookEx Lib "user32" (hHook As DWord) As DWord

	'次のフックを呼び出す関数の宣言
	Declare Function CallNextHookEx Lib "user32" _
					(hHook As DWord, nCode As Long, wParam As DWord, lParam As DWord) As DWord


	Dim hHook   As DWord	           'Hook Handle
	Dim hInst   As DWord	           'Instanc Handle
	Dim hAppWnd As DWord	           'Application Window Handle
 
	Const WH_GETMESSAGE = 3         'フックの種類を示す定数
	Const HC_ACTION     = 0

	Const WM_MusKeyMOVE = (WM_APP+1)

'-----------------------------------------------------------------------------
Function Export DllMain(hinstDLL As DWord, fdwReason As DWord, lpvReserved As VoidPtr) As Long
	'DLLエントリポイント
	Select Case fdwReason
		Case DLL_PROCESS_ATTACH
			'DLLがプロセス空間にロードされた時に実行されます。
			_System_StartupProgram()
			DllMain=1
			hInst=hinstDLL
	End Select
End Function


Function Export StartHook(hWnd As DWord) As Long
	'Hookのインストール
	hHook=SetWindowsHookEx(WH_GETMESSAGE, AddressOf(GetMsgProc), hInst, 0)
	hAppWnd=hWnd
	If hHook=0 Then StartHook=-1
End Function


Function Export EndHook() As Long
	'Hookのアンインストール
	If hHook Then UnhookWindowsHookEx(hHook) Else EndHook=-1
End Function


Function GetMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
	Dim msg	  As *MSG
	Dim a		As Byte
	Dim f		As Long
'Dim c		As Long

	Select Case code
		Case HC_ACTION
		msg=lParam
		Select Case msg->message
			Case WM_NCHITTEST
				a=1
			Case WM_MOUSEMOVE
				a=1
			Case WM_NCMOUSEMOVE
				a=1
			Case WM_MOUSEWHEEL
				a=2
			Case WM_RBUTTONDOWN
				a=3
			Case WM_LBUTTONDOWN
				a=4
			Case WM_MBUTTONDOWN
				a=5
			Case WM_RBUTTONUP
				a=6
			Case WM_LBUTTONUP
				a=7
			Case WM_MBUTTONUP
				a=8
			Case WM_KEYUP
				a=10
				'c=msg->wParam	'c:VK_xxxxx
			Case WM_KEYDOWN
				a=11
				'c=msg->wParam	'c:VK_xxxxx
		End Select
		If a Then
			SendMessage(hAppWnd, WM_MusKeyMOVE, 0, 0)

			'CallNextHookEx(hHook,code,wParam,lParam)
			'GetMsgProc=1
			'Exit Function
		End If
	End Select

	'次のフックを呼び出す
	GetMsgProc = CallNextHookEx(hHook,code,wParam,lParam)
End Function
'-----------------------------------------------------------------------------

コード: 全て選択

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (idHook As DWord, lpfn As DWord,hMod As DWord, dwThreadId As DWord) As DWord
Declare Function UnhookWindowsHookEx Lib "user32" (hHook As DWord) As DWord 
Declare Function CallNextHookEx Lib "user32" (hHook As DWord, nCode As Long, wParam As DWord, lParam As DWord) As DWord

Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (hFile As HANDLE, ByRef lpFileMappingAttributes As SECURITY_ATTRIBUTES, flProtect As DWord, dwMaximumSizeHigh As DWord, dwMaximumSizeLow As DWord, lpName As BytePtr) As HANDLE
Declare Function MapViewOfFile Lib "kernel32" (hFileMappingObject As HANDLE, dwDesiredAccess As DWord, dwFileOffsetHigh As DWord, dwFileOffsetLow As DWord, dwNumberOfBytesToMap As DWord) As VoidPtr
Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As VoidPtr) As Long

Dim hMF As HANDLE
Dim pData As *DWord
Dim hInst As DWord

Const WM_MusKeyMOVE = (WM_USER+1)

Function Export DllMain(hinstDLL As DWord, fdwReason As DWord, lpvReserved As VoidPtr) As Long
	'DLLエントリポイント
	Select Case fdwReason
		Case DLL_PROCESS_ATTACH
			'DLLがプロセス空間にロードされた時に実行されます。
			_System_StartupProgram()
			DllMain=1
			hInst=hinstDLL

			'メモリマップトファイルを作成
			hMF=CreateFileMapping(-1,ByVal NULL,PAGE_READWRITE,0,(4*8)*2,"Mouse Hook Test DLL")
			pData=MapViewOfFile(hMF,FILE_MAP_ALL_ACCESS,0,0,0)
		Case DLL_PROCESS_DETACH
			'DLLがプロセス空間から解除された時に実行されます。
			'メモリマップトファイルを破棄
			UnmapViewOfFile(pData)
			CloseHandle(hMF)
	End Select
 End Function

Function Export StartHook(hWnd As DWord) As Long
	'Hookのインストール
	pData[0]=SetWindowsHookEx(WH_GETMESSAGE, AddressOf(GetMsgProc), hInst, 0)
	pData[1]=hWnd
	If pData[0]=0 Then StartHook=-1
End Function
 
 
Function Export EndHook() As Long
	'Hookのアンインストール
	If pData[0] Then UnhookWindowsHookEx(pData[0]) Else EndHook=-1
End Function

Function GetMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
	Dim msg	  As *MSG
	Dim a		As Byte
	Dim f		As Long
	'Dim c		As Long
	Select Case code
		Case HC_ACTION
		msg=lParam
		Select Case msg->message
			Case WM_NCHITTEST
				a=1
			Case WM_MOUSEMOVE
				a=1
			Case WM_NCMOUSEMOVE
				a=1
			Case WM_MOUSEWHEEL
				a=2
			Case WM_RBUTTONDOWN
				a=3
			Case WM_LBUTTONDOWN
				a=4
			Case WM_MBUTTONDOWN
				a=5
			Case WM_RBUTTONUP
				a=6
			Case WM_LBUTTONUP
				a=7
			Case WM_MBUTTONUP
				a=8
			Case WM_KEYUP
				a=10
				'c=msg->wParam	'c:VK_xxxxx
			Case WM_KEYDOWN
				a=11
				'c=msg->wParam	'c:VK_xxxxx
		End Select
		If a Then
			PostMessage(pData[1],WM_MusKeyMOVE,0,0)

			'CallNextHookEx(pData[0],code,wParam,lParam)
			'GetMsgProc=1
			'Exit Function
		End If
	End Select
	'次のフックを呼び出す
	GetMsgProc = CallNextHookEx(pData[0],code,wParam,lParam)
End Function

コード: 全て選択

Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As HWND
    wHitTestCode As DWord
    dwExtraInfo As DWord
End Type

Function GetMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
    Dim pmh As *MOUSEHOOKSTRUCT
    Dim a        As Byte
    Dim f        As Long
    'Dim c        As Long
    pmh=lParam
    If Code<0 Then
        GetMsgProc=CallNextHookEx(pData[0],nCode,wParam,lParam)
        Exit Function
    End If
    Select Case wParam
        Case WM_NCHITTEST
                a=1
            Case WM_MOUSEMOVE
                a=1
            Case WM_NCMOUSEMOVE
                a=1
            Case WM_MOUSEWHEEL
                a=2
            Case WM_RBUTTONDOWN
                a=3
            Case WM_LBUTTONDOWN
                a=4
            Case WM_MBUTTONDOWN
                a=5
            Case WM_RBUTTONUP
                a=6
            Case WM_LBUTTONUP
                a=7
            Case WM_MBUTTONUP
                a=8
        End Select
        If a Then
            PostMessage(pData[1],WM_MusKeyMOVE,0,0)

            'CallNextHookEx(pData[0],code,wParam,lParam)
            'GetMsgProc=1
            'Exit Function
        End If
    End Select
    '次のフックを呼び出す
    GetMsgProc = CallNextHookEx(pData[0],code,wParam,lParam)
End Function

コード: 全て選択

Class CCallbackThread
Public
	m_idThread As DWord
	Sub CCallbackThread()
		m_hThread=CreateThread(ByVal NULL,0,AddressOf(ThreadProc),VarPtr(This),0,VarPtr(m_idThread))
	End Sub
	Sub ~CCallbackThread()
		Dim ExitCode As Long
		Do
			SendMsg(WM_QUIT,0,0)
			GetExitCodeThread(m_hThread,VarPtr(ExitCode))
			Sleep(0)
		Loop While ExitCode=STILL_ACTIVE
		CloseHandle(m_hThread)
	End Sub
	Function SendMsg(dwMsg As DWord, wParam As DWord, lParam As DWord) As Long
		SendMsg=PostThreadMessage(m_idThread,dwMsg,wParam,lParam)
	End Function
Private
	m_hThread As HANDLE
	Sub ThreadProc()
		Dim msg As MSG
		Do
			PostThreadMessage(m_idThread,WM_USER,0,0)
			If PeekMessage(msg,0,0,0,PM_NOREMOVE)=TRUE Then Exit Do
			Sleep(0)
		Loop
		While GetMessage(msg,0,0,0)
			Select Case msg.message
				Case -1,0
					Exit While
				Case ...
					'メッセージに対する処理
				Case ....
				Case .....
			End Select
		Wend
		ExitThread(&HE0F)
	End Sub
End Class

コード: 全て選択

While GetMessage(msg,0,0,0)
	Select Case msg.message
		Case -1,0
			Exit While
		Case WM_USER+1
			Beep(440,100)
	End Select
Wend

コード: 全て選択

Dim ct As CCallbckThread

ct.SendMsg(WM_USER+1,0,0)

コード: 全て選択

Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As HWND
    wHitTestCode As DWord
    dwExtraInfo As DWord
End Type

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (idHook As DWord, lpfn As DWord,hMod As DWord, dwThreadId As DWord) As DWord
Declare Function UnhookWindowsHookEx Lib "user32" (hHook As DWord) As DWord 
Declare Function CallNextHookEx Lib "user32" (hHook As DWord, nCode As Long, wParam As DWord, lParam As DWord) As DWord

Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (hFile As HANDLE, ByRef lpFileMappingAttributes As SECURITY_ATTRIBUTES, flProtect As DWord, dwMaximumSizeHigh As DWord, dwMaximumSizeLow As DWord, lpName As BytePtr) As HANDLE
Declare Function MapViewOfFile Lib "kernel32" (hFileMappingObject As HANDLE, dwDesiredAccess As DWord, dwFileOffsetHigh As DWord, dwFileOffsetLow As DWord, dwNumberOfBytesToMap As DWord) As VoidPtr
Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As VoidPtr) As Long


Dim hMF As HANDLE
Dim pData As *DWord
Dim hInst As DWord

Const WM_MusKeyMOVE = (WM_USER+1)

Function Export DllMain(hinstDLL As DWord, fdwReason As DWord, lpvReserved As VoidPtr) As Long
    'DLLエントリポイント
    Select Case fdwReason
        Case DLL_PROCESS_ATTACH
            'DLLがプロセス空間にロードされた時に実行されます。
            _System_StartupProgram()
            DllMain=1
            hInst=hinstDLL

            'メモリマップトファイルを作成
            hMF=CreateFileMapping(-1,ByVal NULL,PAGE_READWRITE,0,(4*8)*2,"Mouse Hook Test DLL")
            pData=MapViewOfFile(hMF,FILE_MAP_ALL_ACCESS,0,0,0)
        Case DLL_PROCESS_DETACH
            'DLLがプロセス空間から解除された時に実行されます。
            'メモリマップトファイルを破棄
            UnmapViewOfFile(pData)
            CloseHandle(hMF)
    End Select
 End Function

Function Export StartHook(hWnd As DWord) As Long
    'Hookのインストール
    pData[0]=SetWindowsHookEx(WH_MOUSE, AddressOf(GetMsgProc), hInst, 0)
    pData[1]=hWnd
    If pData[0]=0 Then StartHook=-1
End Function
 
 Function Export EndHook() As Long
    'Hookのアンインストール
    If pData[0] Then UnhookWindowsHookEx(pData[0]) Else EndHook=-1
End Function

Function GetMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
    Dim pmh As *MOUSEHOOKSTRUCT
    Dim a        As Byte
    Dim f        As Long
    'Dim c        As Long
    pmh=lParam
    If code<0 Then
        GetMsgProc=CallNextHookEx(pData[0],code,wParam,lParam)
        Exit Function
    End If
    Select Case wParam
        Case WM_NCHITTEST
        a=1
        Case WM_MOUSEMOVE
            a=1
        Case WM_NCMOUSEMOVE
            a=1
        Case WM_MOUSEWHEEL
            a=2
        Case WM_RBUTTONDOWN
            a=3
        Case WM_LBUTTONDOWN
            a=4
        Case WM_MBUTTONDOWN
            a=5
        Case WM_RBUTTONUP
            a=6
        Case WM_LBUTTONUP
            a=7
        Case WM_MBUTTONUP
            a=8
    End Select
    If a Then
        PostMessage(pData[1],WM_MusKeyMOVE,0,0)
        Exit Function
        'CallNextHookEx(pData[0],code,wParam,lParam)
        'GetMsgProc=1
        'Exit Function
    End If
    '次のフックを呼び出す
    GetMsgProc = CallNextHookEx(pData[0],code,wParam,lParam)
End Function

コード: 全て選択

Dim pData As DWordPtr

コード: 全て選択

Dim p As DWord
p=malloc(4*2)
SetDWord[p,123]
SetDWord[p+4,456]
Print GetDWord(p)
Print GetDWord(p+4)
free(p)

コード: 全て選択

Dim p As DWordPtr
p=malloc(4*2)
p[0]=123
p[1]=456
Print p[0]
Print p[1]
free(p)