EXE只能运行一个...
2009-07-07 12:13
218 查看
把这个单元引用到主窗体中就可以了...经试验有效.
unit RunOne;
interface
const
MI_QUERYWINDOWHANDLE = 1;
MI_RESPONDWINDOWHANDLE = 2;
MI_ERROR_NONE = 0;
MI_ERROR_FAILSUBCLASS = 1;
MI_ERROR_CREATINGMUTEX = 2;
// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;
implementation
uses Forms, Windows;
const
UniqueAppStr = 'ShuanYuan_SoftWare';
var
MessageId: Integer;
WProc: TFNWndProc;
MutHandle: THandle;
MIError: Integer;
function GetMIError: Integer;
begin
Result := MIError;
end;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
Result := 0;
// If this is the registered message
if Msg = MessageID then
begin
case wParam of
MI_QUERYWINDOWHANDLE:
// A new instance is asking for main window handle in order
// to focus the main window, so normalize app and send back
// message with main window handle.
begin
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
Application.MainForm.Handle);
end;
MI_RESPONDWINDOWHANDLE:
// The running instance has returned its main window handle,
// so we need to focus it and go away.
begin
SetForegroundWindow(HWND(lParam));
Application.Terminate;
end;
end;
end
// Otherwise, pass message on to old window proc
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure SubClassApplication;
begin
// We subclass Application window procedure so that
// Application.OnMessage remains available for user.
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
// Set appropriate error flag if error condition occurred
if WProc = nil then
MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;
procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
// Create the mutex with the (hopefully) unique string
MutHandle := CreateMutex(nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;
procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
BSMRecipients: DWORD;
begin
// Prevent main form from flashing
Application.ShowMainForm := False;
// Post message to try to establish a dialogue with previous instance
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
Application.Handle);
end;
procedure InitInstance;
begin
SubClassApplication; // hook application message loop
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
// Mutex object has not yet been created, meaning that no previous
// instance has been created.
DoFirstInstance
else
BroadcastFocusMessage;
end;
initialization
MessageID := RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
// Restore old application window procedure
if WProc <> nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
if MutHandle <> 0 then CloseHandle(MutHandle); // Free mutex
end.
unit RunOne;
interface
const
MI_QUERYWINDOWHANDLE = 1;
MI_RESPONDWINDOWHANDLE = 2;
MI_ERROR_NONE = 0;
MI_ERROR_FAILSUBCLASS = 1;
MI_ERROR_CREATINGMUTEX = 2;
// Call this function to determine if error occurred in startup.
// Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;
implementation
uses Forms, Windows;
const
UniqueAppStr = 'ShuanYuan_SoftWare';
var
MessageId: Integer;
WProc: TFNWndProc;
MutHandle: THandle;
MIError: Integer;
function GetMIError: Integer;
begin
Result := MIError;
end;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
Result := 0;
// If this is the registered message
if Msg = MessageID then
begin
case wParam of
MI_QUERYWINDOWHANDLE:
// A new instance is asking for main window handle in order
// to focus the main window, so normalize app and send back
// message with main window handle.
begin
if IsIconic(Application.Handle) then
begin
Application.MainForm.WindowState := wsNormal;
Application.Restore;
end;
PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
Application.MainForm.Handle);
end;
MI_RESPONDWINDOWHANDLE:
// The running instance has returned its main window handle,
// so we need to focus it and go away.
begin
SetForegroundWindow(HWND(lParam));
Application.Terminate;
end;
end;
end
// Otherwise, pass message on to old window proc
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;
procedure SubClassApplication;
begin
// We subclass Application window procedure so that
// Application.OnMessage remains available for user.
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
// Set appropriate error flag if error condition occurred
if WProc = nil then
MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;
procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
// Create the mutex with the (hopefully) unique string
MutHandle := CreateMutex(nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;
procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
BSMRecipients: DWORD;
begin
// Prevent main form from flashing
Application.ShowMainForm := False;
// Post message to try to establish a dialogue with previous instance
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
Application.Handle);
end;
procedure InitInstance;
begin
SubClassApplication; // hook application message loop
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
// Mutex object has not yet been created, meaning that no previous
// instance has been created.
DoFirstInstance
else
BroadcastFocusMessage;
end;
initialization
MessageID := RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
// Restore old application window procedure
if WProc <> nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
if MutHandle <> 0 then CloseHandle(MutHandle); // Free mutex
end.
相关文章推荐
- 关于多用户模式下同一个.exe只能运行一个
- C#只能运行一个exe进程
- FCL小应用系列-----------如何使得程序只能有一个实例运行?
- Java-->一个只能运行十次的程序
- windows进程限制工具,可以限制其它软件只能运行一个
- 程序只能运行一个实例
- c# 程序只能运行一次(多次运行只能打开同一个程序) 并激活第一个实例,使其获得焦点,并在最前端显示.
- centos7 搭建docker内运行rabbitmq,然后再镜像ha方案的完全教程,暂时一个宿主机只能运行一个docker的rabbitmq,但是集群 ha都正常
- 如何查看一个运行的exe执行程序需要有哪些DLL动态链接库
- 查找一个特定的EXE是否在内存中运行
- shell脚本同一时间只能有一个在运行
- C# WINFORM判断程序是否运行,且只能运行一个实例
- 使应用程序只能运行一个实例
- c# 程序只能运行一次(多次运行只能打开同一个程序) 并激活第一个实例,使其获得焦点,并在最前端显示.
- NSIS 安装包确保只能有一个安装实例运行
- C#只能运行一个实例程序的方法
- 谁能提供一个用C#写的运行exe文件的代码啊
- 让程序只能运行一个实例(来自ccrun)
- Oracle 远程访问配置 在 Windows Forms 和 WPF 应用中使用 FontAwesome 图标 C#反序列化XML异常:在 XML文档(0, 0)中有一个错误“缺少根元素” C#[Win32&WinCE&WM]应用程序只能运行一个实例:MutexHelper Decimal类型截取保留N位小数向上取, Decimal类型截取保留N位小数并且不进行四舍五入操作
- 如何把一个现成的exe文件合并到合并到我的程序里?运行时再释放出来?