怎样让我的应用程序只运行一次?
解决方案 »
- delphi:如何实现控件数组的单击事件?
- Console Application中DOS命令调用的问题
- delphi可不可以编程添加windows的任务计划???
- 有没有人用过用clientdataset 的xmldata属性在服务器和客户端之间传递数据的阿,高分求助
- 为什么finalization的MessageBox看不到?
- 取得毫秒级的API 函数
- 各位用什么,当你不用BDE而要操作dbf文件时?
- 如何让用户在DB_Grid控件中修改数据时只能是PickList属性中指定的值?
- 快救命,我快急死了(关于COPY的问题)
- 很简单的关于缓冲区的问题。
- 紧急求救(做完马上送分100,在线等待)
- 请问哪里有控件能够实现在98、WIN2K下的XP效果,包括FORMS!
防止应用程序的多个实例运行的最佳单元MultInst
1.Writer: GreensPan
2.Time:2001/10/20
3.需求:将本单元加入应用程序的主单元(在主单元的实现部分引用
MultInst);最好在加入主单元后将常量UniqueAppStr改成不同的值,
否则在同一台计算机上不能同时运行都引用了本单元的两个不同的应用
程序。
*************************************************************}
unit MultInst;interfaceconst
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;implementationuses Forms, Windows, SysUtils;const
UniqueAppStr = 'A8B63209-B2D1-4C97-8B97-EEE7C48ED102';var
// UniqueAppStr:PChar;
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);
//OpenNeedSerial; //在MainFrm单元中实现
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.
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};{$R *.RES}
var H: HWND;
begin
Application.Initialize;
Application.Title := '我的项目标题';
H := FindWindow(nil,'我的项目标题');
if H > 0 then
Application.Terminate;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
在dpr里uses Windows,
CreateMutex(Nil, true, 'DGTSrun');//'DGTSrun'随便,作标志
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
Application.Initialize;
Application.CreateForm(TTeach_Main, Teach_Main);
//............
Application.Run;
end;