запускать только одну копию программы...

← →
hawkins (2004-04-07 14:42) [0]

Всем привет! Проблема такая: Хочу сделать возможность запускать только одну копию программы. После запуска первого же экземпляра появляется окно про-мы и тут же закрывается. В чем тут дело?
Делаю так:

program Project1;
uses Forms,Windows,
Unit1 in "Unit1.pas" {Form1} ;
{$R *.RES}

var hwin:HWND;

begin
hwin:=FindWindow("TForm1","Form1");
if hwin<>0 then begin
SetForegroundWindow(hwin);
Application.Terminate;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

← →
panov © (2004-04-07 15:03) [1]

Слов больше нет.

http://delphimaster.net/view/1-1081149715/
http://delphimaster.net/view/1-1081149715/

Вот нужный модуль.
Подключи его первым в секции Uses главной формы

unit MultInst;

interface

Uses Forms,Windows,Dialogs,SysUtils;
Function BroadcastSystemMessage(Flags:DWord;Recipients:PDWord;
uiMessage:UInt;wwParam:wParam;llParam:lParam):LongInt;
stdCall;External "User32.dll";
Const
Mi_No_Error=0;
Mi_Fail_SubClass=1;
Mi_Fail_Create_Mutex=2;

Function GetMIError:Integer; //контроль ошибки при запуске приложения

implementation

Const
UniqueAppStr:PChar="ShmWinEXE";
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:=wsMaximized;
Application.Restore;
end;
SetForeGroundWindow(Application.MainForm.Handle);
end
else
Result:=CallWindowProc(wProc,Handle,Msg,wParam,lParam);
end;
//------------------------------------------------------------------------------
Procedure SubClassApplication;
begin //замена оконной процедуры
wProc:=TFNWndProc(SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(@NewWndProc)));
if wProc=nil then //условие ошибки
MiError:=MiError or Mi_Fail_SubClass;
end;
//------------------------------------------------------------------------------
Procedure DoFirstInstance;
begin
SubClassApplication;
MutHandle:=CreateMutex(nil,false,UniqueAppStr);
if MutHandle=0 then
MiError:=MiError or Mi_Fail_Create_Mutex;
end;
//------------------------------------------------------------------------------
Procedure BroadcastFocusMessage;
Var
BSMRecipients:DWord;
begin
Application.ShowmainForm:=false;
BSMRecipients:=BSM_APPLICATIONS;
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
DoFirstInstance
else
BroadcastFocusMessage;
end;
//------------------------------------------------------------------------------
initialization
MessageID:=RegisterWindowMessage(UniqueAppStr);
InitInstance;
finalization
if wProc <> nil then
SetWindowLong(Application.Handle,GWL_WNDPROC,LongInt(wProc));
end.

запускать только одну копию программы... Найти похожие ветки