关于VB模拟拖放一个文件到别的程序
注意，是模拟拖放给其它程序，不是它自己，谢谢！
这是论坛08年最后一天有人发的一个帖子：
http://topic.csdn.net/u/20081231/21/9a6f660f-5b5c-4f67-86a2-3542b68796b0.html
和他同样的问题，事隔三年，希望有高手能实现一下：
网上找不到VB的源码，只有C＋＋的，代码如下：
C/C++ code
#include "stdafx.h"
#include "windows.h"
#include "shlobj.h"
int main(int argc, char* argv[])
{
char szFile[] = "W:\\zzzzzzzz\\aa\\a.ini";
HWND hWnd = ::FindWindow("Notepad", NULL);
if(hWnd == NULL) return;
DWORD dwBufSize = sizeof(DROPFILES) + sizeof(szFile) + 1;
BYTE *pBuf = NULL;
LPSTR pszRemote = NULL;
HANDLE hProcess = NULL;
__try {
pBuf = new BYTE[dwBufSize];
if(pBuf == NULL) __leave;
memset(pBuf, 0, dwBufSize);
DROPFILES *pDrop = (DROPFILES *)pBuf;
pDrop->pFiles = sizeof(DROPFILES);
strcpy((char *)(pBuf + sizeof(DROPFILES)), szFile);
DWORD dwProcessId;
GetWindowThreadProcessId(hWnd, &dwProcessId);
hProcess = OpenProcess(PROCESS_VM_OPERATION | PROCESS_VM_WRITE, FALSE, dwProcessId);
if(hProcess == NULL) __leave;
pszRemote = (LPSTR)VirtualAllocEx(hProcess, NULL, dwBufSize, MEM_COMMIT, PAGE_READWRITE);
if(pszRemote == NULL) __leave;
if(WriteProcessMemory(hProcess, pszRemote, pBuf, dwBufSize, 0))
::SendMessage(hWnd, WM_DROPFILES, (WPARAM)pszRemote, NULL);
}
__finally {
if(pBuf != NULL) delete []pBuf;
if(pszRemote != NULL) VirtualFreeEx(hProcess, pszRemote, dwBufSize, MEM_FREE);
if(hProcess != NULL) CloseHandle(hProcess);
}
}
谁能帮转成VB，能运行的，谢谢啊，不用百度也不用谷歌，因为就只有http://topic.csdn.net/u/20081231/21/9a6f660f-5b5c-4f67-86a2-3542b68796b0.html
这一篇，其它地方找的也是从这复制过去的，再次感谢！希望高手不吝赐教！！
[最优解释]
改了半天，测试可用了 呵呵
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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Const WM_DROPFILES = &H233
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H100
Private Const PROCESS_VM_WRITE = &H20
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_DECOMMIT As Long = &H4000
Private Const PAGE_READWRITE As Long = 4
Private Const CF_HDROP = 15
Private Type POINT
x As Long
y As Long
End Type
Private Type DROPFILES
pFiles As Long
pt As POINT
fNC As Long
fWide As Long
End Type
Private Sub Command1_Click()
Const sFile = "c:\sh.txt" ' char szFile[] = "W:\\zzzzzzzz\\aa\\a.ini";
Dim pDrop As DROPFILES
Dim szFile() As Byte
Dim aBuf() As Byte
Dim dwBufSize As Long
Dim pBuf As Long
szFile = StrConv(sFile, vbFromUnicode)
Debug.Print LBound(szFile)
dwBufSize = Len(pDrop) + (UBound(szFile) + 1) + 1
'DWORD dwBufSize = sizeof(DROPFILES) + sizeof(szFile) + 1;
ReDim aBuf(dwBufSize - 1)
pBuf = VarPtr(aBuf(0))
'设置 DROPFILES 的属性
pDrop.pFiles = Len(pDrop)
'将 DROPFILES 复制到 Buf 中
Call CopyMemory(ByVal pBuf, ByVal VarPtr(pDrop), Len(pDrop))
'Debug.Print LBound(szFile)
Call CopyMemory(ByVal VarPtr(aBuf(Len(pDrop))), ByVal VarPtr(szFile(0)), (UBound(szFile) + 1))
Dim hwnd As Long
hwnd = FindWindow("Notepad", vbNullString)
'HWND hWnd = ::FindWindow("Notepad", NULL);
If hwnd = 0 Then MsgBox ("没有找到进程！"): Exit Sub
Dim dwProcessId As Long
Call GetWindowThreadProcessId(hwnd, dwProcessId)
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, False, dwProcessId)
If hProcess = 0 Then MsgBox ("无法打开句柄！"): Exit Sub
Dim pszRemote As Long
pszRemote = VirtualAllocEx(hProcess, 0, dwBufSize, MEM_COMMIT, PAGE_READWRITE)
Debug.Print pszRemote
If (WriteProcessMemory(hProcess, pszRemote, aBuf(0), dwBufSize, 0)) Then
Call SendMessage(hwnd, WM_DROPFILES, pszRemote, 0)
Else
MsgBox ("write内存失败")
End If
End Sub
