ab.com コミュニティ

ノッチ様、ありがとう御座います。

"Test.zip"頂きました。

> そうですか、間違えて作成中のファイルをアップロードしたのかと思って
> 自分でダウンロードして試してみたのですが、やっぱり正常動作するんですよ。

何が違うのでしょうかネ？

> Test.exeでSetSubClassとEndSubClassの
> 戻り値を表示するようにしました。
> それぞれの関数は成功すると1、失敗すると0を返します。

どちらも"１"ですが、依然として状態は変わりません？


> 引き続き他の方も試していただけませんか。


宜しくお願いします。

そうですか、間違えて作成中のファイルをアップロードしたのかと思って
自分でダウンロードして試してみたのですが、やっぱり正常動作するんですよ。

ちなみにファイルを少し編集してます。
どこを変えたかというと

bFlagに0を代入するタイミング
あ余計なMessageBoxを削除してTest.exeでSetSubClassとEndSubClassの
戻り値を表示するようにしました。
それぞれの関数は成功すると1、失敗すると0を返します。

Testフォルダに入っている1.exeを実行してTest.pjをデバッグ実行するだけで
確認できます。

引き続き他の方も試していただけませんか。

7様、試して頂きましてありがとう御座います。

[quote]Windows XP Home SP2ですけど、「コピー ～ test」を実行した後に、「test」を起動すると「コピー ～ test」が落ちます。(不安定になる？)
というか、起動するたびに動きが違います。起動した途端に落ちる時もあるし、起動してイケたか！？と思うと落ちたり、フリーズしかける時もあるし(最終的には落ちます)。[/quote]同じ様な状態で、環境が原因ではない様ですね。

>他の方で試された方はいませんか？


宜しくお願いします。

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr

ReplyMessage(pProc As LRESULT)

> ちなみに他の方で試された方はいませんか？
> 同じもので動作が違うのであれば原因がわかりません。
Windows XP Home SP2ですけど、「コピー ～ test」を実行した後に、「test」を起動すると「コピー ～ test」が落ちます。(不安定になる？)
というか、起動するたびに動きが違います。起動した途端に落ちる時もあるし、起動してイケたか！？と思うと落ちたり、フリーズしかける時もあるし(最終的には落ちます)。

[code]pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr[/code][code]ReplyMessage(pProc As LRESULT)[/code]
この二つのコードが怪しいと思います。

SetSubClass()関数の中のGetWindowLong(hTarget,GWL_WNDPROC)の戻り値も、CallWndProc()関数の中のGetWindowLong(hTarget,GWL_WNDPROC)の戻り値も 0 なので、SetWindowLong()関数が上手くいってないんじゃないんでしょうか。

> 依然として状態は、変わりません？

変わりませんか。
ちなみに他の方で試された方はいませんか？
同じもので動作が違うのであれば原因がわかりません。

ノッチ様、ありがとう御座います。

"dll.zip"頂きました。

[quote]こちらの環境では正常動作するので、これでもエラーになるようですと
PCの違いによる問題かもしれません。(ないとは思いますが)[/quote]
依然として状態は、変わりません？

宜しくお願いします。

> その前に、二回目に頂いたコードですが、これで正常に動作するか試して頂けますか？
>
> 環境：XP Home SP 2
> 　　　AB Ver4.24.00
> [hide=DLLのコード]#include "dll.idx"
>
> '-------------------------------------------------------------------
> ' メモ - このファイルには、DLLの構成要素を記述します。
> ' （例：関数定義、グローバル変数、定数定義など）
> '
> ' エクスポートが必要な関数には、"Export" 修飾子を指定します。
> ' （例：Function Export FuncName() As Long）
> '-------------------------------------------------------------------
>
> '下のNUM_SUBCLASS_WNDを変更すると同時にサブクラス化できるウィンドウ数を変更できる
> Const SUBCLASS_SET=1234567890 As WPARAM
> Const SUBCLASS_UNSET=987654321 As WPARAM
> Dim hInst As HINSTANCE
> Dim hTarget As HWND
> Dim hHook As HANDLE
> Dim pProc As VoidPtr
> Dim bFlag As BOOL
>
>
> Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(idHook As Long,lpfn As VoidPtr,hMod As HINSTANCE,dwThreadId As DWord) As HANDLE
> Declare Function CallNextHookEx Lib "user32"(hhk As HANDLE,nCode As Long,wParam As WPARAM,lParam As LPARAM) As LRESULT
> Declare Function UnhookWindowsHookEx Lib "user32"(hhk As HANDLE) As BOOL
> Declare Function ReplyMessage Lib "user32"(lResult As LRESULT) As BOOL
> Const WH_CALLWNDPROC=4
> Const HC_ACTION =0
> Type CWPSTRUCT
> lParam As LPARAM
> wParam As WPARAM
> message As DWord
> hWnd As HWND
> End Type
> Const Static1=1000
> Const Static2=1001
> Const Static3=1002
> Const Static4=1003
> Const Static5=1004
>
> Function Export DllMain(hinstDLL As HINSTANCE, fdwReason As DWord, lpvReserved As VoidPtr) As Long
> 'DLLエントリポイント
> Select Case fdwReason
> Case DLL_PROCESS_ATTACH
> 'DLLがプロセス空間にロードされた時に実行されます。
> _System_StartupProgram()
> hInst=hinstDLL
> hTarget=0
> DllMain=1
> End Select
> End Function
>
> Function Export SetSubClass(hWnd As HWND) As Long
> SetSubClass=0
> If hTarget Then Exit Function
> bFlag=0
> hTarget=hWnd
> Dim ThreadID As DWord
> ThreadID=GetWindowThreadProcessId(hTarget,NULL)
> hHook=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf(CallWndProc),hInst,ThreadID)
> If hHook=0 Then Exit Function
> pProc=SendMessage(hTarget,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
> SetSubClass=1
> 'msgbox 0,Str$(AddressOf(SubClassProc) As Double),"SubClassProc"
> 'msgbox 0,Str$(pProc As Long)
> GetWindowLong(hTarget,GWL_WNDPROC)
> msgbox 0,Str$(GetLastError()),"GetLastError"
> End Function
>
> Function Export EndSubClass() As Long
> EndSubClass=0
> If hTarget=0 Then Exit Function
> bFlag=0
> SendMessage(hTarget,WM_NULL,SUBCLASS_UNSET,pProc As Long)
> hTarget=0
> UnhookWindowsHookEx(hHook)
> EndSubClass=1
> End Function
>
> Function CallWndProc(code As DWord,wParam As DWord,lParam As *CWPSTRUCT) As DWord
> If code=HC_ACTION Then
> If bFlag=0 Then
> If lParam->message=WM_NULL Then
> If lParam->wParam=SUBCLASS_SET Then
> bFlag=1
> pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
> msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC)),"GetWindowLong"
> msgbox 0,Str$(pProc As Double),"戻り値(元のアドレス)"
> msgbox 0,Str$(lParam->lParam),"設定したアドレス"
> ReplyMessage(pProc As LRESULT)
> End If
> End If
> End If
> End If
> CallWndProc=CallNextHookEx(pProc,code,wParam,lParam As LPARAM)
> End Function
>
> Function SubClassProc(hWnd As HWND,message As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
> Select Case message
> Case WM_CTLCOLORSTATIC
> SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
> 'ここに色変更の処理を追加
> Select Case GetWindowLong(lParam As HWND,GWL_ID)
> Case Static1'これはID
> SetTextColor(wParam As HDC,&H000000FF)
> 'SubClassProcにブラシハンドルを指定すると背景色も変更できます
> Case Static2
> SetTextColor(wParam As HDC,&H0000FF00)
> Case Static3
> SetTextColor(wParam As HDC,&H00FF0000)
> Case Static4
> SetTextColor(wParam As HDC,&H0000FFFF)
> Case Static5
> SetTextColor(wParam As HDC,&H00FFFF00)
> End Select
> 'こんな感じで
> Exit Function
> Case WM_NULL
> If wParam=SUBCLASS_UNSET Then
> SetWindowLong(hWnd,GWL_WNDPROC,pProc As Long)
> Exit Function
> End If
> Case WM_DESTROY
> EndSubClass()
> End Select
> SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
> End Function[/hide]

こちらの環境では
GetWindowLongの戻り値が0、
GetLastErrorの戻り値が5、
とはなりましたが、正常にサブクラス化されて文字色が変更されました。
AB 4.24.00 WindowsXP Home SP2

で、メールはなくてOKです。
[url]http://www.filebank.co.jp/guest/myanoh/[/url]
こちらにアクセスしてファイルをダウンロードして下さい。
ゲストフォルダログインという画面になるので
ファイルバンクID：myanoh
フォルダ名：absubclass
パスワード：1234
でゲストフォルダにログインできます。
開いた画面で、環境設定をクリックしてブラウザモードに変更したら
ダウンロードでファイルを落とすことができます。
dll.zipの中に
Dllフォルダ：DLLのプロジェクト
testフォルダ：DLLのSetSubClassを呼び出すプロジェクト
コピー ～ testフォルダ：サブクラス用にStaticを配置したプロジェクト
がありますので、まず「コピー ～ test」内のtest.exeを実行して
「test」プロジェクトでデバッグ実行なりコンパイルして実行をして下さい。
こちらの環境では正常動作するので、これでもエラーになるようですと
PCの違いによる問題かもしれません。(ないとは思いますが)

ノッチ様、ありがとう御座います。

[quote]差し支えなければmsn宛に空メールでも送ってもらえないですか？
こちらで作成したプログラムを送付しますので。[/quote]
その前に、二回目に頂いたコードですが、これで正常に動作するか試して頂けますか？

環境：XP Home SP 2
　　　AB Ver4.24.00
[hide=DLLのコード]#include "dll.idx"

'-------------------------------------------------------------------
' メモ - このファイルには、DLLの構成要素を記述します。
' （例：関数定義、グローバル変数、定数定義など）
'
' エクスポートが必要な関数には、"Export" 修飾子を指定します。
' （例：Function Export FuncName() As Long）
'-------------------------------------------------------------------

'下のNUM_SUBCLASS_WNDを変更すると同時にサブクラス化できるウィンドウ数を変更できる
Const SUBCLASS_SET=1234567890 As WPARAM
Const SUBCLASS_UNSET=987654321 As WPARAM
Dim hInst As HINSTANCE
Dim hTarget As HWND
Dim hHook As HANDLE
Dim pProc As VoidPtr
Dim bFlag As BOOL


Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(idHook As Long,lpfn As VoidPtr,hMod As HINSTANCE,dwThreadId As DWord) As HANDLE
Declare Function CallNextHookEx Lib "user32"(hhk As HANDLE,nCode As Long,wParam As WPARAM,lParam As LPARAM) As LRESULT
Declare Function UnhookWindowsHookEx Lib "user32"(hhk As HANDLE) As BOOL
Declare Function ReplyMessage Lib "user32"(lResult As LRESULT) As BOOL
Const WH_CALLWNDPROC=4
Const HC_ACTION =0
Type CWPSTRUCT
lParam As LPARAM
wParam As WPARAM
message As DWord
hWnd As HWND
End Type
Const Static1=1000
Const Static2=1001
Const Static3=1002
Const Static4=1003
Const Static5=1004

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

Function Export SetSubClass(hWnd As HWND) As Long
SetSubClass=0
If hTarget Then Exit Function
bFlag=0
hTarget=hWnd
Dim ThreadID As DWord
ThreadID=GetWindowThreadProcessId(hTarget,NULL)
hHook=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf(CallWndProc),hInst,ThreadID)
If hHook=0 Then Exit Function
pProc=SendMessage(hTarget,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
SetSubClass=1
'msgbox 0,Str$(AddressOf(SubClassProc) As Double),"SubClassProc"
'msgbox 0,Str$(pProc As Long)
GetWindowLong(hTarget,GWL_WNDPROC)
msgbox 0,Str$(GetLastError()),"GetLastError"
End Function

Function Export EndSubClass() As Long
EndSubClass=0
If hTarget=0 Then Exit Function
bFlag=0
SendMessage(hTarget,WM_NULL,SUBCLASS_UNSET,pProc As Long)
hTarget=0
UnhookWindowsHookEx(hHook)
EndSubClass=1
End Function

Function CallWndProc(code As DWord,wParam As DWord,lParam As *CWPSTRUCT) As DWord
If code=HC_ACTION Then
If bFlag=0 Then
If lParam->message=WM_NULL Then
If lParam->wParam=SUBCLASS_SET Then
bFlag=1
pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC)),"GetWindowLong"
msgbox 0,Str$(pProc As Double),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
ReplyMessage(pProc As LRESULT)
End If
End If
End If
End If
CallWndProc=CallNextHookEx(pProc,code,wParam,lParam As LPARAM)
End Function

Function SubClassProc(hWnd As HWND,message As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
Select Case message
Case WM_CTLCOLORSTATIC
SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
'ここに色変更の処理を追加
Select Case GetWindowLong(lParam As HWND,GWL_ID)
Case Static1'これはID
SetTextColor(wParam As HDC,&H000000FF)
'SubClassProcにブラシハンドルを指定すると背景色も変更できます
Case Static2
SetTextColor(wParam As HDC,&H0000FF00)
Case Static3
SetTextColor(wParam As HDC,&H00FF0000)
Case Static4
SetTextColor(wParam As HDC,&H0000FFFF)
Case Static5
SetTextColor(wParam As HDC,&H00FFFF00)
End Select
'こんな感じで
Exit Function
Case WM_NULL
If wParam=SUBCLASS_UNSET Then
SetWindowLong(hWnd,GWL_WNDPROC,pProc As Long)
Exit Function
End If
Case WM_DESTROY
EndSubClass()
End Select
SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
End Function[/hide]
宜しくお願いします。

[list]戻り値は、"５"でした。[/list]

5はアクセスができない時に出ます。

差し支えなければmsn宛に空メールでも送ってもらえないですか？
こちらで作成したプログラムを送付しますので。

[quote]GetWindowLongが失敗するのであれば、その直後にGetLastError()を呼び出して
見てください。
もしかしたらhTargetがうまく取得できてないかもしれません。[/quote][list]Function Export SetSubClass(hWnd As HWND) As Long
　　　　　・
　　　　　・
　　　　　・
If hHook=0 Then Exit Function
pProc=SendMessage(hTarget,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
SetSubClass=1
[color=red]GetWindowLong(hTarget,GWL_WNDPROC)
msgbox 0,Str$(GetLastError()),"GetLastError"[/color]
End Function[/list]戻り値は、"５"でした。

宜しくお願いします。

> [list]pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
> [color=red]msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
> msgbox 0,Str$(lParam->lParam),"設定したアドレス"[/color]
> ReplyMessage(pProc As LRESULT)
> [/list]両方共､"アドレス値"が入っています。
> GetWindowLong(hTarget,GWL_WNDPROC)の戻り値だけは､0です。

GetWindowLongが失敗するのであれば、その直後にGetLastError()を呼び出して
見てください。
もしかしたらhTargetがうまく取得できてないかもしれません。
msgbox 0,Str$(hTarget)
をGetWindowLongの直前くらいにいれるとどうですか？

イグトランス様、ありがとう御座います。

[quote]エラーになった関数の直後にGetLastErrorを呼び出してどうなっているか調べてみたらどうでしょうか？[/quote]

強制終了するので、何処かがエラーしていると思ったのですが、
GetLastError()で調べても戻り値は0で､どこがエラーなのか解らない状態です。

[quote]pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)
の間に
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
を入れてみてください。
最初のメッセージボックスはなんらかの数値、2つ目は"0"になるのではないかと
思います。[/quote]
[list]pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
[color=red]msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"[/color]
ReplyMessage(pProc As LRESULT)
[/list]両方共､"アドレス値"が入っています。
GetWindowLong(hTarget,GWL_WNDPROC)の戻り値だけは､0です。


宜しくお願いします。

横入り失礼ですが，エラーになった関数の直後にGetLastErrorを呼び出してどうなっているか調べてみたらどうでしょうか？

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)

[quote][quote]SetSubClassの前後で
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
を入れてみて対象のウィンドウがサブクラス化されているか、[/quote]
戻り値：0 サブクラス化されていないです。[/quote]
ここ重要です。
恐らくSetSubClassをする前は何らかの数値がでたと思いますが、
SetSubClassの後で戻り値が0ということはサブクラス化失敗ではなく
(GetWindowLongが失敗の可能性もありますが)
一応サブクラス化に成功はしているが、サブクラスに指定したアドレスが
間違っている。ということだと思います。

考えられる原因は
1) SetSubClass内のAddressOf(SubClassProc)でアドレスの獲得に失敗している
2) CallWndProc内のSetWindowLongが失敗している
でしょうか。
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
の戻り値が0になっているということはSetWindowLong自体は成功しているよう
なので多分1)が原因のような気がします。

ですので、今度はCallWndProc内の
[code]pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)[/code]
の間に
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
を入れてみてください。
最初のメッセージボックスはなんらかの数値、2つ目は"0"になるのではないかと
思います。

> [quote] Case WM_NULL
> If wParam=SUBCLASS_UNSET Then
> SetWindowLong(hWnd,GWL_WNDPROC,pProc)[/quote]
> ｢"SetWindowLong"の第3パラメータが、VoidPtrからLongに強制変換されています。｣と
> 警告が出ますが気にしなくても良いですか？

SetWindowLongの第3パラメータはLong型でDeclare宣言されているので
SetWindowLong(hWnd,GWL_WNDPROC,pProc As Long)
と第3パラメータはLong型だと明示的に表現することで警告はでなくなります。