I
import
Unregistered / Unconfirmed
GUEST, unregistred user!
如何向指定程序发送消息
如何向指定程序发送消息（并不是网络的发送）。需要用到 RegisterWindowMessage、SendMessage吗？又怎样用？请尽可能举例！谢谢
回复贴子：
回复人：PoolD(2000-8-13 1:04:00) 得150分
发送者：
var
SendText: string;
SendDataStruct: CopyDataStruct;
begin
SendText := 'Send';
SendDataStruct.cbData := length(Sendtext);
SendDataStruct.lpData := @SendText[1];
SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));
end;
接收者：
procedure DataIn(var DataMessage: TWMCopyData); message wm_copydata;
procedure DataIn(var DataMessage: TWMCopyData);
var
ReceieveData : CopyDataStruct;
temp: pchar;
ReceieveStr : string;
begin
ReceieveData := DataMessage.CopyDataStruct^;
temp := ReceieveData.lpdata;
ReceieveStr := string(temp);
end;
回复人：xiaohuilau(2000-8-13 11:17:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
|
光标停在上面那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 11:19:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
¦
光标停在上面那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 11:20:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
光标停在'(@'那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 12:58:00) 得0分
PoolD:
**************
我试过了你的程序，在Form里测试是没有问题的。出现上面的错误原因系我把发送者放在 DLL 里。请问如何解决？
**************
谢谢
回复人：PoolD(2000-8-13 13:21:00) 得0分
to xiaohuilau:
试一下把Application.Handle改成0。
回复人：xiaohuilau(2000-8-13 18:49:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, 0,lparam(@SendDataStruct));出现错误
光标停在** 'lparam(@sendDataStruct' **那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
为了感谢你的帮助，我将分数加到了 150 分。
回复人：PoolD(2000-8-13 19:05:00) 得0分
to xiaohuilau
这段代码我试过，编译可以通过。我的一个程序就是用这种方法发送信息的。
是否可以把你写的这部分代码发给我看一下？
分数倒无所谓，重要的是解决问题。^_^
回复人：xiaohuilau(2000-8-13 19:11:00) 得0分
PoolD:我的代码如下
library hk;
uses
SysUtils,
Classes,
hkproc in 'hkproc.pas';
exports EnableHotKeyHook,DisableHotKeyHook;
begin
hNextHookProc:=0;
procSaveExit:=ExitProc;
end.
***************************************************
unit hkproc;
interface
uses Windows,Messages,Dialogs,SysUtils,ShellAPI;
var
intMainHWND:Longint;//主程序句柄，用于发送消息时用
Shell_TrayWnd:longint;
CtrlDown:Boolean;
hNextHookProc:HHook;
procSaveExit
ointer;
function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
function EnableHotKeyHook(MainProgramHWND:longint):Bool;export;
function DisableHotKeyHook:bool;Export;
implementation
function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
const
_Keypressmask=$80000000;
var lpPoint:TPoint;
hwnd:longint;
strClassName,strTrayClassName:String;
SendText: string;//向主程序发送的消息串
SendDataStruct: CopyDataStruct;//消息类型
begin
result:=0;
if iCode<0 then
begin
Result:=CallNextHookEx(hNextHookProc,iCode,wParam,lParam);
exit;
end;
//判断CLASSNAME 与 WND 所用的 LPPOINT 是不，同的。
GetCursorPos(lpPoint);
hwnd:=WindowFromPoint(lpPoint);//读取鼠标指向的控制句柄
SetLength(strClassName,255+2);
GetClassName(hwnd,PChar(strClassName),255);//读取句柄的名字
strClassName:=UpperCase(strClassName);
lpPoint.x :=LOWORD(lParam);//读取鼠标的X标
lpPoint.y :=HIWORD(lParam);//读取鼠标的Y标
hwnd:=WindowFromPoint(lpPoint);//读取鼠标指向的控制句柄
strTrayClassName:='SHELL_TRAYWND';//任务栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
if hwnd=Shell_TrayWnd then
begin
if (wparam=WM_NCRBUTTONUP) or (wparam=WM_NCLBUTTONDOWN) then
begin
Result:=1;
exit;
end;
end;{if WND}
strTrayClassName:='SYSTABCONTROL';//任务栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then exit;
strTrayClassName:='TRAYNOTIFYWND';//页
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_RBUTTONUP) then
begin
hwnd:=GetParent(GetParent(GetParent(hWnd)));
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
strTrayClassName:='BUTTON';//开始按钮
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
hwnd:=GetParent(hWnd);
if hWnd=Shell_TrayWnd then
begin
if (wparam=WM_RBUTTONUP) or (wparam=WM_LBUTTONDOWN) then Result:=1;
if wparam=WM_LBUTTONUP then
begin
SendText := 'Send';
SendDataStruct.lpData := @SendText[1];
SendDataStruct.cbData := length(Sendtext);
//***************** * * * * 当按下开始按钮时发送信息。
SendMessage(intMainHWND, WM_CopyData,0, lparam(@SendDataStruct));
//***************** * * * *
end;
exit;
end;{if hwnd}
end;
strTrayClassName:='REBARWINDOW';//页
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_RBUTTONUP) or (wparam=WM_LBUTTONDOWN) then
begin
hwnd:=GetParent(hWnd);
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
strTrayClassName:='TOOLBARWINDOW';//工具栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_LBUTTONDOWN) or (wparam=WM_RBUTTONUP) or (wparam=WM_RBUTTONDOWN) then
begin
hwnd:=GetParent(GetParent(hWnd));
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
end;
function EnableHotKeyHook(MainProgramHWND:longint):Bool;export;
begin
intMainHWND:=MainProgramHWND;
Shell_TrayWnd:= FindWindow('Shell_TrayWnd', nil);
result:=False;
if hNextHookProc<>0 then exit;
hNextHookProc:=SetWindowsHookEx(WH_MOUSE,KHH,Hinstance,0);
Result:=hNextHookProc<>0;
end;
function DisableHotKeyHook:Bool;export;
begin
if hNextHookPRoc<>0 then
begin
UnhookWindowsHookEx(hNextHookProc);
hNextHookProc:=0;
MessageBeep(0);
end;
Result:=hNextHookProc=0;
end;
procedure HotKeyHookExit;
begin
if hNextHookProc<>0 then DisableHotKeyHook;
end;
end.
回复人：PoolD(2000-8-13 19:50:00) 得0分
function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
定义参数名的时候最好不要用保留字。
参数lParam和lparam(@SendDataStruct)重复了。
回复人：xiaohuilau(2000-8-13 20:28:00) 得0分
非常感谢 PoolD
如何向指定程序发送消息（并不是网络的发送）。需要用到 RegisterWindowMessage、SendMessage吗？又怎样用？请尽可能举例！谢谢
回复贴子：
回复人：PoolD(2000-8-13 1:04:00) 得150分
发送者：
var
SendText: string;
SendDataStruct: CopyDataStruct;
begin
SendText := 'Send';
SendDataStruct.cbData := length(Sendtext);
SendDataStruct.lpData := @SendText[1];
SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));
end;
接收者：
procedure DataIn(var DataMessage: TWMCopyData); message wm_copydata;
procedure DataIn(var DataMessage: TWMCopyData);
var
ReceieveData : CopyDataStruct;
temp: pchar;
ReceieveStr : string;
begin
ReceieveData := DataMessage.CopyDataStruct^;
temp := ReceieveData.lpdata;
ReceieveStr := string(temp);
end;
回复人：xiaohuilau(2000-8-13 11:17:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
|
光标停在上面那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 11:19:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
&brvbar;
光标停在上面那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 11:20:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, Application.Handle, lparam(@SendDataStruct));出现错误
光标停在'(@'那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
回复人：xiaohuilau(2000-8-13 12:58:00) 得0分
PoolD:
**************
我试过了你的程序，在Form里测试是没有问题的。出现上面的错误原因系我把发送者放在 DLL 里。请问如何解决？
**************
谢谢
回复人：PoolD(2000-8-13 13:21:00) 得0分
to xiaohuilau:
试一下把Application.Handle改成0。
回复人：xiaohuilau(2000-8-13 18:49:00) 得0分
PoolD:
我照你的方法做但会在SendMessage(FindWindow(PCHAR('TForm1'), PCHAR('form1')), WM_CopyData, 0,lparam(@SendDataStruct));出现错误
光标停在** 'lparam(@sendDataStruct' **那处，出现[Error] hkproc.pas(72): Missing operator or semicolon错误
请教请教，万分感谢！
为了感谢你的帮助，我将分数加到了 150 分。
回复人：PoolD(2000-8-13 19:05:00) 得0分
to xiaohuilau
这段代码我试过，编译可以通过。我的一个程序就是用这种方法发送信息的。
是否可以把你写的这部分代码发给我看一下？
分数倒无所谓，重要的是解决问题。^_^
回复人：xiaohuilau(2000-8-13 19:11:00) 得0分
PoolD:我的代码如下
library hk;
uses
SysUtils,
Classes,
hkproc in 'hkproc.pas';
exports EnableHotKeyHook,DisableHotKeyHook;
begin
hNextHookProc:=0;
procSaveExit:=ExitProc;
end.
***************************************************
unit hkproc;
interface
uses Windows,Messages,Dialogs,SysUtils,ShellAPI;
var
intMainHWND:Longint;//主程序句柄，用于发送消息时用
Shell_TrayWnd:longint;
CtrlDown:Boolean;
hNextHookProc:HHook;
procSaveExit
ointer;function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
function EnableHotKeyHook(MainProgramHWND:longint):Bool;export;
function DisableHotKeyHook:bool;Export;
implementation
function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
const
_Keypressmask=$80000000;
var lpPoint:TPoint;
hwnd:longint;
strClassName,strTrayClassName:String;
SendText: string;//向主程序发送的消息串
SendDataStruct: CopyDataStruct;//消息类型
begin
result:=0;
if iCode<0 then
begin
Result:=CallNextHookEx(hNextHookProc,iCode,wParam,lParam);
exit;
end;
//判断CLASSNAME 与 WND 所用的 LPPOINT 是不，同的。
GetCursorPos(lpPoint);
hwnd:=WindowFromPoint(lpPoint);//读取鼠标指向的控制句柄
SetLength(strClassName,255+2);
GetClassName(hwnd,PChar(strClassName),255);//读取句柄的名字
strClassName:=UpperCase(strClassName);
lpPoint.x :=LOWORD(lParam);//读取鼠标的X标
lpPoint.y :=HIWORD(lParam);//读取鼠标的Y标
hwnd:=WindowFromPoint(lpPoint);//读取鼠标指向的控制句柄
strTrayClassName:='SHELL_TRAYWND';//任务栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
if hwnd=Shell_TrayWnd then
begin
if (wparam=WM_NCRBUTTONUP) or (wparam=WM_NCLBUTTONDOWN) then
begin
Result:=1;
exit;
end;
end;{if WND}
strTrayClassName:='SYSTABCONTROL';//任务栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then exit;
strTrayClassName:='TRAYNOTIFYWND';//页
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_RBUTTONUP) then
begin
hwnd:=GetParent(GetParent(GetParent(hWnd)));
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
strTrayClassName:='BUTTON';//开始按钮
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
hwnd:=GetParent(hWnd);
if hWnd=Shell_TrayWnd then
begin
if (wparam=WM_RBUTTONUP) or (wparam=WM_LBUTTONDOWN) then Result:=1;
if wparam=WM_LBUTTONUP then
begin
SendText := 'Send';
SendDataStruct.lpData := @SendText[1];
SendDataStruct.cbData := length(Sendtext);
//***************** * * * * 当按下开始按钮时发送信息。
SendMessage(intMainHWND, WM_CopyData,0, lparam(@SendDataStruct));
//***************** * * * *
end;
exit;
end;{if hwnd}
end;
strTrayClassName:='REBARWINDOW';//页
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_RBUTTONUP) or (wparam=WM_LBUTTONDOWN) then
begin
hwnd:=GetParent(hWnd);
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
strTrayClassName:='TOOLBARWINDOW';//工具栏
if Copy(strClassName,1,length(strTrayClassName))=strTrayClassName then
begin
if (wparam=WM_LBUTTONDOWN) or (wparam=WM_RBUTTONUP) or (wparam=WM_RBUTTONDOWN) then
begin
hwnd:=GetParent(GetParent(hWnd));
if hWnd=Shell_TrayWnd then Result:=1;
end;
end;
end;
function EnableHotKeyHook(MainProgramHWND:longint):Bool;export;
begin
intMainHWND:=MainProgramHWND;
Shell_TrayWnd:= FindWindow('Shell_TrayWnd', nil);
result:=False;
if hNextHookProc<>0 then exit;
hNextHookProc:=SetWindowsHookEx(WH_MOUSE,KHH,Hinstance,0);
Result:=hNextHookProc<>0;
end;
function DisableHotKeyHook:Bool;export;
begin
if hNextHookPRoc<>0 then
begin
UnhookWindowsHookEx(hNextHookProc);
hNextHookProc:=0;
MessageBeep(0);
end;
Result:=hNextHookProc=0;
end;
procedure HotKeyHookExit;
begin
if hNextHookProc<>0 then DisableHotKeyHook;
end;
end.
回复人：PoolD(2000-8-13 19:50:00) 得0分
function KHH(iCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;export;
定义参数名的时候最好不要用保留字。
参数lParam和lparam(@SendDataStruct)重复了。
回复人：xiaohuilau(2000-8-13 20:28:00) 得0分
非常感谢 PoolD