64位VBA中如何向Total Commander发送WM_COPYDATA消息？

尝试使用64位VBA向Total Commander（TC）发送WM_COPYDATA消息，目前无错误提示但功能无法实现，已做如下排查：

• TC设置无误，AutoHotkey的SendMessage可正常调用TC内部命令
• 执行result = SendMessage(hwndTC, 1075, 4001, 0) 'FocusLeft可正常生效，说明已正确获取TC的句柄，消息发送通路正常
• 无法正常工作的是Sub TC_SetPath(hwndTarget, UserCMD As String)子过程，尝试过多种cds.cbData赋值方式均无效：

  cds.cbData = Len(UserCMD) + 1  ' 无效
  cds.cbData = Len(UserCMD) + 2  ' 无效
  cds.cbData = (Len(UserCMD) + 1)*2  ' 无效
  

• 尝试过将字符串转为字节数组的代码，仍无效且无错误提示：

  Sub TC_SetPath(hwndTarget, UserCMD As String)
     Dim cds As CopyDataStruct, result As LongPtr
     Dim MsgBytes() As Byte
     MsgBytes = StrConv(UserCMD, vbUnicode)
     
     cds.dwData = Asc("E") + 256 * Asc("M")  'OK
     
     cds.cbData = UBound(MsgBytes)
     cds.lpData = VarPtr(MsgBytes(1))   'OK
     
     ' Send the WM_COPYDATA message
     result = SendMessage(hwndTarget, WM_COPYDATA, 0, VarPtr(cds))
     If result = 0 Then
         Debug.Print "3"
         Debug.Print GetLastErrorStr(Err.LastDllError) 'The operation completed successfully.
     End If
  End Sub
  

第二版修改后的VBA代码 #

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        
Public Type CopyDataStruct
    dwData As LongPtr
    cbData As Long
    lpData As LongPtr
End Type
Private Const WM_COPYDATA = &H4A

Sub test()
    Call TC_SendUserCMD("em_focusfile")
End Sub

Sub TC_SendUserCMD(UserCMD As String)
    Dim cds As CopyDataStruct, result As LongPtr
    Dim hwndTC As LongPtr
    Dim wParam As LongPtr
    wParam = 0
    hwndTC = FindWindow("TTOTAL_CMD", vbNullString)
    
    cds.dwData = Asc("E") + 256 * Asc("M")
    cds.cbData = Len(UserCMD) * 2 + 2
    cds.lpData = StrPtr(UserCMD)
    result = SendMessage(hwndTC, WM_COPYDATA, wParam, cds)
End Sub

第一版VBA代码 #

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPtr

Public Type CopyDataStruct
    dwData As LongPtr
    cbData As LongPtr
    lpData As LongPtr
End Type
Private Const WM_COPYDATA = &H4A
Sub test()
    Dim newPath As String
    ThisFile = "D:\xxx\xxx\.mhtml"
    newPath = ThisFile & "\:\n" & "\0"
    hwndTC = FindWindow("TTOTAL_CMD", vbNullString)
    result = SendMessage(hwndTC, 1075, 4001, 0)  'FocusLeft  OK
    result = SendMessage(hwndTC, 1075, 3001, 0)  'NewTab  OK
    
    Call TC_SetPath(hwndTC, newPath)
End Sub

Sub TC_SetPath(hwndTarget, UserCMD As String)
    Dim cds As CopyDataStruct
    
    cds.dwData = Asc("C") + 256 * Asc("D")  'OK
    ' cds.cbData = (Len(UserCMD) + 1)*2  'also tried, not work
    cds.cbData = Len(UserCMD) + 1  
    cds.lpData = StrPtr(UserCMD)   'OK
    
    ' Send the WM_COPYDATA message
    result = SendMessage(hwndTarget, WM_COPYDATA, 0, cds)
End Sub

可正常实现功能的AutoHotkey脚本 #

F1::
{
    ThisFile:="D:\xxx\xxx.mhtml"

    newPath:=ThisFile . "\:\r" . "\0"
    SendMessage(0x433,4001,0,, "ahk_class TTOTAL_CMD")   ; FocusLeft
    SendMessage(0x433,3001,0,, "ahk_class TTOTAL_CMD")   ; NewTab
    TC_SetPath(newPath)                                 ; CD to DirPath
}
TC_SetPath(userCommand) 
{
    static dwData := 17475  ;Ord("C") +256*Ord("D")
    static WM_COPYDATA := 0x4A
    cbData := Buffer(StrPut(userCommand, 'CP0'))
    StrPut(userCommand, cbData, 'CP0')
    COPYDATASTRUCT := Buffer(A_PtrSize * 3)
    NumPut('Ptr', dwData, 'Ptr', cbData.size, 'Ptr', cbData.ptr, COPYDATASTRUCT)
    MsgResult:=SendMessage( WM_COPYDATA,, COPYDATASTRUCT,, "ahk_class TTOTAL_CMD")
    return MsgResult
}

内容的提问来源于stack exchange，提问作者Valuex