VB6之SendMessage模拟拖放事件

最新推荐文章于 2024-06-23 07:05:13 发布

weixin_30341745

最新推荐文章于 2024-06-23 07:05:13 发布

阅读量361

点赞数

文章标签： c/c++

原文链接：http://www.cnblogs.com/lichmama/p/4142685.html

版权

原文链接：http://hi.baidu.com/coo_boi/item/e1e0f5ab45bddbdd5af191df

网上找了个C++的翻一下，原文链接：http://www.cnblogs.com/zhujian198/archive/2009/07/14/1523426.html

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub RtlZeroMemory Lib "kernel32" (dest As Any, ByVal numBytes As Long)
    
Private Type POINTAPI
        x As Long
        y As Long
End Type
    
Private Type DROPFILES
    pFiles As Long
    pt As POINTAPI
    fNC As Long
    fWide As Long
End Type
    
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, _
    ByVal lpAddress As Long, _
    ByVal dwSize As Long, _
    ByVal flAllocationType As Long, _
    ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, _
    ByVal lpBaseAddress As Long, _
    lpBuffer As Any, _
    ByVal nSize As Long, _
    lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const WM_DROPFILES = &H233&
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCSS_VM_READ = &H100&
Private Const PROCESS_VM_WRITE = &H20&
Private Const MEM_COMMIT = &H1000&
Private Const PAGE_READWRITE = &H4&
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    
    
    
Private Sub Command1_Click()
    Dim hWnd As Long
    Dim dwPid As Long
    Dim hProc As Long
    Dim pMem As Long
    Dim pBuff() As Byte
    Dim objDFS As DROPFILES
    Dim dwBuffSize As Long
    Dim szFileName() As Byte
        
    szFileName = StrConv("d:\1.txt", vbFromUnicode)
    dwBuffSize = Len(objDFS) + UBound(szFileName) + 2
        
    ReDim pBuff(dwBuffSize - 1)
    Call RtlZeroMemory(ByVal VarPtr(pBuff(0)), dwBuffSize)
    Call RtlZeroMemory(ByVal VarPtr(objDFS), Len(objDFS))
    objDFS.pFiles = Len(objDFS)
    Call CopyMemory(ByVal VarPtr(pBuff(0)), ByVal VarPtr(objDFS), Len(objDFS))
    Call CopyMemory(ByVal VarPtr(pBuff(Len(objDFS))), ByVal VarPtr(szFileName(0)), UBound(szFileName) + 1)
    
    hWnd = FindWindow("notepad", vbNullString)
    If hWnd Then
        Call GetWindowThreadProcessId(hWnd, dwPid)
        hProc = OpenProcess(&H8& + &H20&, False, dwPid)
        If hProc Then
            pMem = VirtualAllocEx(hProc, 0&, dwBuffSize, MEM_COMMIT, PAGE_READWRITE)
            If pMem Then
                Debug.Print pMem
                If WriteProcessMemory(hProc, pMem, pBuff(0), dwBuffSize, 0&) Then
                    Call SendMessage(hWnd, WM_DROPFILES, pMem, ByVal 0&)
                    Debug.Print "SendMessage OK"
                Else
                    Debug.Print "WriteProcessMemory Failed"
                End If
                Call VirtualFree(ByVal pMem, dwBuffSize, 0&)
            End If
            Call CloseHandle(hProc)
        End If
    End If
End Sub