How to send WM_COPYDATA to Total Commander in VBA 64bit?

104 views Asked by At

I am trying send WM_COPYDATA to Totoal Commander (TC) using VBA.
Here is what I've done so far.
And there is no error message.

What I've checked

  1. The setting in TC is correct because I can call TC's internal commands using sendmessage in Autohotkey.
  2. For result = SendMessage(hwndTC, 1075, 4001, 0) 'FocusLeft , it works.
    That means the hwnd of Total commander has been correctly got And the message has been correctly sent.
  3. The not workable part is the Sub TC_SetPath(hwndTarget, UserCMD As String) . I've checked some other code and tried to make following change
cds.cbData = Len(UserCMD) + 1  ' not work
cds.cbData = Len(UserCMD) + 2  ' not work
cds.cbData = (Len(UserCMD) + 1)*2  ' not work
  1. I've also tried the code here 1. That is to covert the string input to Byte. Still doesn't work and no error message.
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

Any help would be appreciated. Thanks.

2nd version of VBA code based on the suggetions so far

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

This is the 1st version of VBA code.

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, https://stackoverflow.com/questions/35950108/send-variable-in-lparam-in-vba-for-excel
    cds.cbData = Len(UserCMD) + 1  
    cds.lpData = StrPtr(UserCMD)   'OK
    
    ' Send the WM_COPYDATA message
    result = SendMessage(hwndTarget, WM_COPYDATA, 0, cds)
End Sub

Workable Autohotkey Script

And below is the workable Autohotkey script with the same function.

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) 
{
    ; https://www.autohotkey.com/boards/viewtopic.php?p=538463&sid=4471e03917209854441ac07ebdc70901#p538463
    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
}
1

There are 1 answers

14
FaneDuru On

Please, try the next adapted code:

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 Long, lParam As Any) As LongPtr

Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
        (ByVal dwFlags As Long, lpSource As Any, _
        ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
        ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) As Long
        
Public Type CopyDataStruct
    dwData As LongPtr
    cbData As LongPtr
    lpData As LongPtr
End Type
Private Const WM_COPYDATA = &H4A

'Error Messages read__________________________________________________
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Const LANG_USER_DEFAULT = &H400&
'____________________________________________________________________

Sub test()
    Dim newPath As String, ThisFile As String, hwndTC As LongPtr, result As LongPtr
    ThisFile = "C:\Users\wei_x\Desktop\Nepcon2024\0a7722dd-e8a5-4036-9250-19e0932fe2a9.mhtml"
    newPath = ThisFile & "\:\n" & "\0"
    hwndTC = FindWindow("TTOTAL_CMD", vbNullString)
    result = SendMessage(hwndTC, 1075, 4001, 0)  'FocusLeft  OK
    If result = 0 Then
        Debug.Print GetLastErrorStr(Err.LastDllError) 'The operation completed successfully.
    End If
    result = SendMessage(hwndTC, 1075, 3001, 0)  'NewTab  OK
    If result = 0 Then
        Debug.Print GetLastErrorStr(Err.LastDllError) 'The operation completed successfully.
    End If
    Call TC_SetPath(hwndTC, newPath)
End Sub

Function GetLastErrorStr(dwErrCode As Long) As String

  Static sMsgBuf As String * 257, dwLen As Long

  dwLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM _
                        Or FORMAT_MESSAGE_IGNORE_INSERTS _
                        Or FORMAT_MESSAGE_MAX_WIDTH_MASK, _
                        ByVal 0&, _
                        dwErrCode, LANG_USER_DEFAULT, _
                        ByVal sMsgBuf, 256&, CLngPtr(0))

  If dwLen Then
      GetLastErrorStr = Trim$(Left$(sMsgBuf, dwLen))
  Else
     GetLastErrorStr = "Unknown error."
  End If

End Function

Sub TC_SetPath(hwndTarget, UserCMD As String)
    Dim cds As CopyDataStruct, result As LongPtr
    
    cds.dwData = Asc("C") + 256 * Asc("D")  'OK
    cds.cbData = Len(UserCMD) + 1
    cds.lpData = StrPtr(UserCMD)   'OK
    
    ' Send the WM_COPYDATA message
    result = SendMessage(hwndTarget, WM_COPYDATA, 0, cds)
    If result = 0 Then
        Debug.Print GetLastErrorStr(Err.LastDllError) 'The operation completed successfully.
    End If
End Sub

Now, you can have a confirmation if the API calls work correctly...