Çalışan uygulama açık ise uyarı versin.

Çalışan uygulama açık ise uyarı versin. - Baskı Önizleme

+- Delphi Can (https://www.delphican.com)
+-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Genel Programlama (https://www.delphican.com/forumdisplay.php?fid=6)
+--- Konu Başlığı: Çalışan uygulama açık ise uyarı versin. (/showthread.php?tid=7118)

Çalışan uygulama açık ise uyarı versin. - Bay_Y - 30-12-2022

Herkese kolaylıklar diliyorum.

Bir konu hakkında yardım rica ediyorum.

Çalışan uygulamanın zaten arka planda çalışıp çalışmadığını kontrol etmek istiyorum. Yani kullanıcı daha önce açmış ve çalışıyor ise ikinci bir kez açtığında uygulama zaten açık demek istiyorum.

function processExists(exeFileName: string): Boolean;
var
 ContinueLoop: BOOL;
 FSnapshotHandle: THandle;
 FProcessEntry32: TProcessEntry32;
begin
 FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
 ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
 Result := False;
 while Integer(ContinueLoop) <> 0 do
 begin
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
     UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
     UpperCase(ExeFileName))) then
   begin
     Result := True;
   end;
   ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
 end;
 CloseHandle(FSnapshotHandle);
end;

Burda arka planda çalışan uygulamalarda olup olmadığını anlamak mümkün fakat bunu kontrol etmek için programı açmak gerekiyor ve açıldığında zaten yeni bir exe oluştuğu için herhalukarda açık diyor. ( Ana formunu create kısmında kontrol etmeyi denedim. Ama tabiki doğru bir yöntem değil)

Nasıl bir yol izlemem gerekiyor.

Herkese şimdiden teşekkürler.

Çalışan uygulama açık ise uyarı versin. - COMMANDX - 30-12-2022

procedure TForm1.FormCreate(Sender: TObject);
begin
//---------------------GLOBAL ATOM MUTEX ONLY 1 RUN START --------------
CreateMutex(nil,FALSE,'PROGRAMADI abc 1.00');
if GetLastError = ERROR_ALREADY_EXISTS then
 begin
  ShowMessage('Program zaten çalışıyor');
  Halt(0);
 end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
Sem: THandle;
begin
Sem := CreateSemaphore(nil, 0, 1, 'PROGRAM_NAME');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
  CloseHandle(Sem);
  ShowMessage('Program Çalışmakda');
  Halt;
end;
end;

Bunlardan birini deneyiniz.

Çalışan uygulama açık ise uyarı versin. - Bay_Y - 30-12-2022

Bilgilendirme için çok teşekkür ederim. İşimi gördü. Sağolun.

Çalışan uygulama açık ise uyarı versin. - yhackup - 30-12-2022

(30-12-2022, Saat: 10:47)Bay_Y Adlı Kullanıcıdan Alıntı: Bilgilendirme için çok teşekkür ederim. İşimi gördü. Sağolun.

Yanlış hatırlamıyorsam uygulama kapatırken Mutexi kapatmak lazımdı sanki. Oluşturduğunuz mutexin handle bir yerde tutun form close olayında close yapın yine de.

Çalışan uygulama açık ise uyarı versin. - Bay_Y - 30-12-2022

Teşekkürler