周
周晓晖
Unregistered / Unconfirmed
GUEST, unregistred user!
我想防止程序的第二份事例但registerwindowmessage函数返回总是
0,以下是原代码
unit MultInst;
//****控制应用程序只有一个实例****
//
//
//
interface
uses Windows,Forms,SysUtils,Dialogs,messages;
//function BroadcastSystemMessage(FlagsWORD;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
UniqueAppStrchar='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
BSMRecipientsWORD;
LWORD;
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.
0,以下是原代码
unit MultInst;
//****控制应用程序只有一个实例****
//
//
//
interface
uses Windows,Forms,SysUtils,Dialogs,messages;
//function BroadcastSystemMessage(FlagsWORD;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
UniqueAppStrchar='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
BSMRecipientsWORD;
LWORD;
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.