Проверка запущена ли ещё одна копия приложения

[Vol666]

Есть у кого-нибудь решение данной проблемы? Решать это двумя программами нельзя.

[Alex Cones]

Ищите хендл с классом и заголовком Вашего окна - не найдете - копия одна, найдете - кильните его.

Можно еще так:

program Project1;

uses
  Windows,
  Forms,
  Dialogs,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}
Var HM :THandle;

function Check: boolean;
begin
  HM:=OpenMutex(MUTEX_ALL_ACCESS, false, 'Proj');
  Result:=(HM<>0);
  if HM=0 then HM:=CreateMutex(nil, false, 'Proj');
end;

begin
If Check then
begin
  ShowMessage('Извините, но одна из копий программы уже запущена.');
  exit;
end;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

[ОДИНОЧЕСТВО В СЕТИ]

delphiworld

uses
  SysUtils, WinTypes, WinProcs, WinCrt;
..............................................
var
  NumInstances, SavePrevInst: word;
......................................................
procedure GetInstanceData(hInst, Offset, Size: Word); far; external 'KERNEL';
begin
  SavePrevInst := hPrevInst;
  NumInstances := 0;
  while hPrevInst <> 0 do
  begin
    GetInstanceData(hPrevInst, Ofs(hPrevInst), SizeOf(hPrevInst));
    Inc(NumInstances);
  end;
  Writeln('Уже запущено ', NumInstances, ' копий программы');
  hPrevInst := SavePrevInst;
end.

[JTG]

delphiworld
...
GetInstanceData

Что ещё раз доказывает, что delphiworld - сборник, извиняюсь, быдлокода.

[raxp]

почему забыли про - GlobalAddAtom? в проекте формы...

var PIWin : hWnd;
    AtomFN: WParam;
begin
  //антизапуск 2-копии
  PIWin := FindWindow(WINDOWCLASSNAME, NIL);
  if PIWin <> 0 then
    begin
     if Paramcount = 0 then halt;
     AtomFN := GlobalAddAtom(pChar(paramstr(1)));
     PostMessage(PIWin, CM_OPENFILE, AtomFN, 0);
     halt;
    end;
  //Run program
  Application.Initialize;
  ...

[andreibtzt]

procedure TForm1.FormCreate(Sender: TObject);
Var ExtEndedStyle:dword;
Wnd : hWnd;
buff : Array[0.. 127] of Char;
Begin
Wnd := GetWindow(Handle, gw_HWndFirst);
While Wnd <> 0
DO
Begin
If (Wnd <> Application.Handle)
and (GetWindow(Wnd, gw_Owner) = 0) Then
Begin GetWindowText (Wnd, buff, sizeof (buff ));
If StrPas (buff) = Application.Title Then
Begin
showmessage('....');
Halt;
End;
End;
Wnd := GetWindow (Wnd, gw_hWndNext);
End;
End;

[mutabor]

AtomFN := GlobalAddAtom(pChar(paramstr(1)));

А если запустить из другой директории?

эмм.. 1 это вроде уже доп. параметр, 0 - путь к программе, судя по коду там 0 должен быть, или я не так понял?

[BaronTreep]

Можно ещё с помощью мьютекса это сделать. Только не в .pas файлах, а в главном проекте .dpr:

// ...

var
  H, hMutex : THandle;

{
  -- Мьютекс для блокировки копии второй программы
  -- При попытке запуска второй копии - переключение на существующую
}

begin
  hMutex := CreateMutex(nil, False, 'OneCopyMutex');
  H := FindWindow('TMainFormGUI', nil);
  if WaitForSingleObject(hMutex, 0) <> Wait_TimeOut then begin
      Application.Initialize;
      Application.CreateForm(TMainFormGUI, MainFormGUI);
      Application.CreateForm(TAboutBox, AboutBox);
      Application.CreateForm(TPlagInForm, PlagInForm);
      Application.CreateForm(TInspectForm, InspectForm);
      // ...
      Application.Run;
  end else begin
      SetForegroundWindow(H);
      exitprocess(0);
  end;
end.