C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA(最近はPMillマクロとFusion360APIが多い)

ファイル間リンクの取得8

こちらの続きです。
ファイル間リンクの取得2 - C#ATIA
3年程前に断念したVBAでのファイル間リンク情報取得なのですが、
昨日から少し手ごたえを感じています。

元にしているコードはこちらです。
Catia V5 Get Links
過去に紹介したサイトが幾つも消えてしまっているのですが、
消えていなくて助かっています。が、あまりにコードが汚いのも本音です。

「リンク...」(英語環境 Links...)コマンドを実行し、出てくるダイアログの情報を
WinAPIでゴリゴリに取得しようと言うマクロなのですが、大元は32bitの頃に
作成されたもので、前回取り組んだ際はOSが64bitでVBAが32bitだったような
記憶です。

まだ途中ですが、ダイアログのリストビューにアクセスする辺りまでのコードです。

'vba リンクダイアログ取得テスト

Option Explicit

'--- win api ---
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
    As Long

'--
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, _
    ByVal msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Any _
    ) As Long 'Ptr

Private Declare PtrSafe Function SendMessageStr Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As String) _
    As Long 'Ptr

Private Declare PtrSafe Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long 'Ptr

Private Const WM_GETTEXT = &HD
Private Const HDM_GETITEMCOUNT = (&H1200 + 0)
Private Const WM_CLOSE = &H10

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEM As Long = (LVM_FIRST + 5)
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45

'--
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
    ByVal hWndParent As LongPtr, _
    ByVal lpEnumFunc As LongPtr, _
    ByVal lParam As Long) _
    As Long
    
Private Declare PtrSafe Function ShowWindow Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    ByVal nCmdShow As Long) _
    As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
    
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) _
    As LongPtr

Private Declare PtrSafe Function GetWindow Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    ByVal wCmd As Long) _
    As LongPtr
Private Const GW_HWNDNEXT = 2

Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpString As String, _
    ByVal cch As Long) _
    As Long

Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () _
    As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'--
Private F_hwnd As LongPtr
Private L_hwnd As LongPtr
Private ListCount As Long

Sub CATMain()

    'コマンド実行
    CATIA.StartCommand ("リンク...") ' ("Links...") '
    CATIA.RefreshDisplay = True
    
    'リンクダイアログ取得
    F_hwnd = FindWindowLike("ドキュメントのリンク") '("Links of document") '
    'ShowWindow F_hwnd, SW_HIDE
    
    'リンクダイアログ内のリストビュー(SysListView32)ハンドル取得
    Sleep 100
    Call EnumChildWindows(F_hwnd, AddressOf EnumChildWindow, 0)
    
    'Row数
    Dim rows As Long
    rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0)
    
    'リストビューヘッダーのハンドル取得 : Column数取得に必要
    Dim hWndHeader As Long 'Long
    hWndHeader = SendMessage(L_hwnd, LVM_GETHEADER, 0, ByVal 0&)
    
    'Column数
    Dim cols As Long
    cols = SendMessageStr(hWndHeader, HDM_GETITEMCOUNT, 0, 0)
        
    'リンクダイアログ閉じる
    'ShowWindow F_hwnd, SW_SHOW
    SendMessageAny F_hwnd, WM_CLOSE, 0, 0
    
    Stop
End Sub

Private Function EnumChildWindow( _
    ByVal hChild As LongPtr, _
    ByVal lParam As LongPtr) _
    As Long
    
    Dim iClass As String
    Dim iText As String
    Dim j As LongPtr
    
    iClass = String(255, vbNullChar) 'Space(256)
    j = GetClassName(hChild, iClass, 63)
    iClass = Left(iClass, CLng(j))
    iText = String(255, vbNullChar) 'Space(256)
    j = SendMessageStr(hChild, WM_GETTEXT, 255, iText)
    iText = Left(iText, CLng(j))
    If iClass = "SysListView32" Then
        ListCount = ListCount + 1
        If ListCount = 2 Then
            L_hwnd = hChild: EnumChildWindow = 0: Exit Function
        End If
    End If
    EnumChildWindow = 1 ' Continua enumerarea
    
End Function

Private Function FindWindowLike( _
    strPartOfCaption As String) _
    As LongPtr
    
    Dim hwnd As LongPtr
    Dim strCurrentWindowText As String
    Dim r As Integer
    hwnd = GetForegroundWindow
    Do Until hwnd = 0
        strCurrentWindowText = String(255, vbNullChar) 'Space(256)
        r = GetWindowText(hwnd, strCurrentWindowText, 255)
        strCurrentWindowText = Left$(strCurrentWindowText, r)
        If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop
    Exit Function
Found:
    FindWindowLike = hwnd
    
End Function

正直な所、
・WinAPIの引き数・戻り値の型に自信が有りません
・EnumChildWindow、FindWindowLikeは動くレベルまでの
 修正しかしていません。

実際に実行してみるとこんな感じです。
f:id:kandennti:20190227111409p:plain
ローカルウィンドウに表示されているものは、リンクのダイアログに入っている
リストビューの行と列の数等で、それなりに取得できているのがわかります。
(あまりに汚いのでコードを記載していませんが、その後のコードで
 リンク情報は全て取得出来ています)

悩んでいるのは、2度目以降実行すると
f:id:kandennti:20190227111419p:plain
数値が取得出来なくなります。何故?

単に取得する際のSendMessage類が機能しないのか?
一回目の実行後の終了の仕方が悪いのか?
何をどうすれば良いのか・・・。

但し、この様な操作をすると、再度取得が出来ます。
例えば、WinAPIのSendMessage関数の戻り値の型をこんな感じに
修正します。

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
・・・
    ) As Long 'Ptr

 ↓

    ) As LongPtr

当然、SendMessage関数の利用先では型の不一致でエラーとなります。
そこで、SendMessage関数の戻り値の型を元に戻すと再び正しく取得出来ます。
但し1度だけです。

感覚的に、宣言セクションにある程度影響のある修正を加えると、1度だけ
正しく取得出来ているような感じです。
f:id:kandennti:20190227111435p:plain
どうでも良い部分にスペースを入れて、削除ぐらいではダメなんですが。

この様な現象を経験された方いらっしゃいませんか?
どの様に対策を取れば良いのだろう?
不安定な挙動なので、何かしらが正しくなくてギリギリ動いているのは
実感しているのですが、ゴールへの道筋があるのに辿り着けない・・・。