Советы по Delphi. Версия 1.0.6 - [11]

procedure ActivatePreviousInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;
var
 ClassName : array[0..30] of char;
begin
 Result := true;
 if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin
  GetClassName(Wnd, ClassName, 30);
  if STRIComp(ClassName,'TApplication')=0 then begin
   TargetWindow^:= Wnd;
   Result := false;
  end;
 end;
end;

procedure ActivatePreviousInstance;
var
 PrevInstWnd: HWnd;
begin
 PrevInstWnd:= 0;
 EnumWindows(@EnumApps,LongInt(@PrevInstWnd));
 if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then
  ShowWindow(PrevInstWnd,SW_Restore)
 else
  BringWindowToTop(PrevInstWnd);
end;

end.

Решение 2

Предоставленное разработчиками Delphi 2 Пачекой (Pacheco) и Тайхайрой (Teixeira) и значительно переработанное.

unit multinst;
{Применение:
 Необходимый код в исходном проекте
 if InitInstance then begin
  Application.Initialize;
  Application.CreateForm(TFrmSelProject, FrmSelProject);
  Application.Run;
 end;
 Это все понятно (я надеюсь)}
interface
uses Forms, Windows, Dialogs, SysUtils;
const
 MI_NO_ERROR = 0;
 MI_FAIL_SUBCLASS = 1;
 MI_FAIL_CREATE_MUTEX = 2;
{ Проверка правильности запуска приложения с помощью описанных ниже функций. }
{ Количество флагов ошибок MI_* может быть более одного. }
function GetMIError: Integer;
Function InitInstance : Boolean;

implementation

const
 UniqueAppStr : PChar;   {Различное для каждого приложения}
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;
   ShowWindow(Application.Mainform.Handle, sw_restore);
  end;
  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;

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);
end;

Function InitInstance : Boolean;
begin
 MutHandle:= OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
 if MutHandle = 0 then begin
  { Объект Mutex еще не создан, означая, что еще не создано }
  { другое приложение. }
  ShowWindow(Application.Handle, SW_ShowNormal);
  Application.ShowMainForm:=True;
  DoFirstInstance;
  result:= True;
 end else begin
  BroadcastFocusMessage;
  result:= False;
 end;
end;

initialization
begin
 UniqueAppStr:= Application.Exexname;
 MessageID:= RegisterWindowMessage(UniqueAppStr);
 ShowWindow(Application.Handle, SW_Hide);
 Application.ShowMainForm:=FALSE;
end;

finalization
begin
 if WProc <> Nil then
  { Приводим приложение в исходное состояние }
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
end;

end.

Решение 3

VAR MutexHandle:THandle;
Var UniqueKey: string;
FUNCTION IsNextInstance:BOOLEAN;
BEGIN
 Result:=FALSE;
 MutexHandle:=0;
 MutexHandle:=CREATEMUTEX(NIL,true, uniquekey);
 IF MutexHandle<>0 THEN BEGIN
  IF GetLastError=ERROR_ALREADY_EXISTS THEN BEGIN
   Result:=TRUE;
   CLOSEHANDLE(MutexHandle);
   MutexHandle:=0;
  END;
 END;
END;

begin
 CmdShow:=SW_HIDE;
 MessageId:=RegisterWindowMessage(zAppName);
 Application.Initialize;
 IF IsNextInstance THEN PostMessage(HWND_BROADCAST, MessageId,0,0)
 ELSE BEGIN
  Application.ShowMainForm:=FALSE;
  Application.CreateForm(TMainForm, MainForm);
  MainForm.StartTimer.Enabled:=TRUE;
  Application.Run;
 END;
 IF MutexHandle<>0 THEN CLOSEHANDLE(MutexHandle);
end.

В MainForm вам необходимо вставить обработчик внутреннего сообщения

PROCEDURE TMainForm.OnAppMessage(VAR M:TMSG; VAR Ret:BOOLEAN);
BEGIN
IF M.Message=MessageId THEN BEGIN
 Ret:=TRUE;
 // Поместить окно наверх !!!!!!!!
 END;
END;

INITIALIZATION
 ShowWindow(Application.Handle, SW_Hide);
END.

Каким образом, программным путем, можно узнать о завершении запущенной программы?

16-битная версия:

uses Wintypes,WinProcs,Toolhelp,Classes,Forms;

Function WinExecAndWait(Path: string; Visibility: word): word;
var
 InstanceID: THandle;