registerwindowmessage为什么不管用(95分)

  • 主题发起人 周晓晖
  • 开始时间

周晓晖

Unregistered / Unconfirmed
GUEST, unregistred user!
我想防止程序的第二份事例但registerwindowmessage函数返回总是
0,以下是原代码
unit MultInst;

//****控制应用程序只有一个实例****
//
//
//

interface

uses Windows,Forms,SysUtils,Dialogs,messages;

//function BroadcastSystemMessage(Flags:DWORD;Recipients: PDWORD;uiMessage:UINT;
// wParam:WPARAM;lParam:LPARAM):Longint;stdcall;external 'user32.dll';

const
MI_ON_ERROR =0;
MI_FAIL_SUBCLASS =1;
MI_FAIL_CREATE_MUTEX =2;

WM_SeteTo = WM_USER+1008;

function GetMiError:Integer;


implementation


const
UniqueAppStr:pchar='NetScreen Email!';
var
MessageId:Integer;
WProc:TFNWndProc=Nil;
MutHandle:Thandle=0;
MiError:Integer=0;
function GetMiError :Integer;
begin

Result:=MIError;
end;


function NewWndProc(Handle:HWND;Msg:Integer;wParam,lParam:Longint):Longint;stdcall;
begin

//如果是注册的消息
if Msg=MessageId then

begin

//如果主窗口已最小化,就恢复成原来的大小
if IsIconic(Application.Handle) then

begin

Application.MainForm.WindowState:=wsNormal;
Application.Restore;
end;

//处理新参数
sendmessage(Application.MainForm.Handle,wm_seteTo,0,0);//lparam);
//激活第一个实例
SetForegroundWindow(Application.MainForm.Handle);
end
//否则,就把消息传递给原来的窗口过程
else

Result:=CallWindowProc(WProc,Handle,Msg,wParam,lParam);
end;


procedure SubClassApplication;
begin

//替换应用对象的窗口程序以使Application OnMessage对用户仍然可用
WProc:=TFNWndProc(SetWindowLong(Application.Handle,GWL_WNDPROC,
Longint(@NewWndProc)));
//假如错误发生时设置合适的错误标志
if WProc=Nil then

MIError:=MIError or MI_FAIL_SUBCLASS;
end;


proceduredo
FirstInstance;
begin

SubClassApplication;
MutHandle:=CreateMutex(nil,False,UniqueAppStr);
if MutHandle=0 then

MIError:=MIError or MI_FAIL_CREATE_MUTEX;
end;


//如果已经有实例存在,就会调用这个过程
procedure BroadCastFocusMessage;
var
BSMRecipients:DWORD;
L:DWORD;
strETo:string;
begin

//暂时隐去主Form
Application.ShowMainForm:=False;
//广播一个消息通知其他实例激活自己
BSMRecipients:=BSM_APPLICATIONS;

//取第二次运行参数
if ParamCount > 0 then

begin

strETo:=ParamStr(1);
delete(strETo,1,16);
// L := GlobalAddAtom(PChar(strETo));

BroadCastSystemMessage(BSF_IGNORECURRENTTASK OR BSF_POSTMESSAGE,@BSMRecipients,
MessageId,0,0);
{ 传递原子句柄 }
// GlobalDeleteAtom(L);
{ 使用后释放 }
end
else

BroadCastSystemMessage(BSF_IGNORECURRENTTASK OR BSF_POSTMESSAGE,@BSMRecipients,
MessageId,0,0);
Application.Terminate;
end;


procedure InitInstance;
begin

MutHandle:=OpenMutex(MUTEX_ALL_ACCESS,False,UniqueAppStr);

if MutHandle=0 then

//互斥对象还没有创建,说明没有实例存在
do
FirstInstance
else

BroadcastFocusMessage;
end;



initialization
MessageID:=RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
If WProc<>Nil then

//恢复原来的窗口过程
SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(Wproc));
end.
 
没有人谈谈想法吗?
 
控制只运行一个实例可以使用吃互斥对象的方法来实现。以下是我的代码。
Mutex:=CreateMutex(nil,true,'WinMailShell');
if GetLastError<>ERROR_ALREADY_EXISTS then

begin

while(GetMessage(Msg,0,0,0))do

begin

TranslateMessage(msg);
DispatchMessage(msg);
end;

ReleaseMutex(Mutex);
end;
 
用全局原子也可以实现:
ret:=globalfindatom('HuangJiang Charge Station');//查找有没有注册原子
if ret=0 then
//没有就增加一个
ret:=globaladdatom('HuangJiang Charge Station')
else
begin

application.MessageBox('不能同时运行两个同样的程序!',
'错误',MB_OK+MB_ICONSTOP);
application.Terminate;
end;

 
接受答案了.
 
顶部