Delphi de Program Bir defa Çalışsın

[QuAdR]

var
 Mutex: THandle;


function KillApp(const sCapt: PChar) : boolean;
var
 AppHandle:THandle;
 Tid, Pid: integer;
begin
 AppHandle:=FindWindow(Nil, sCapt);
 Tid := GetWindowThreadProcessid(AppHandle, @Pid);
 AppHandle := OpenProcess(PROCESS_ALL_ACCESS,False,Pid);
 TerminateProcess(AppHandle,0);
end;

begin
 Application.Initialize;
 Mutex := CreateMutex(nil , False, pchar(ExtractFileName(Application.ExeName)));
 if GetLastError = ERROR_ALREADY_EXISTS then
 begin
   if messagedlg('Açık olan programı kapatmak istiyormusunuz?', mtError, mbOKCancel, 0) = 1 then
     KillApp('Program')
   else
      ExitProcess(0);
  end;

 Application.CreateForm(TfrmMain, frmMain);
 Application.Run;
end.

[woywod]

(14-01-2022, Saat: 19:52)QuAdR Adlı Kullanıcıdan Alıntı:

var
 Mutex: THandle;


function KillApp(const sCapt: PChar) : boolean;
var
 AppHandle:THandle;
 Tid, Pid: integer;
begin
 AppHandle:=FindWindow(Nil, sCapt);
 Tid := GetWindowThreadProcessid(AppHandle, @Pid);
 AppHandle := OpenProcess(PROCESS_ALL_ACCESS,False,Pid);
 TerminateProcess(AppHandle,0);
end;

begin
 Application.Initialize;
 Mutex := CreateMutex(nil , False, pchar(ExtractFileName(Application.ExeName)));
 if GetLastError = ERROR_ALREADY_EXISTS then
 begin
   if messagedlg('Açık olan programı kapatmak istiyormusunuz?', mtError, mbOKCancel, 0) = 1 then
     KillApp('Program')
   else
      ExitProcess(0);
  end;

 Application.CreateForm(TfrmMain, frmMain);
 Application.Run;
end.

 Elinize Sağlık..

[mcuyan]

@QuAdR hocam tam çözemedim..

Bir yerde yanlış yapıyorum ama nerede.. Project source kısmında kullandım kodları..

Proje açık ise confirm alıyor okey. Fakat kapat dediğimde hiç bir işlem yapmıyor.. Killapp kısmı çalışmıyor..

[vedat35]

(30-01-2022, Saat: 21:39)mcuyan Adlı Kullanıcıdan Alıntı: @QuAdR hocam tam çözemedim..

Bir yerde yanlış yapıyorum ama nerede.. Project source kısmında kullandım kodları..

Proje açık ise confirm alıyor okey. Fakat kapat dediğimde hiç bir işlem yapmıyor.. Killapp kısmı çalışmıyor..

oradaki kod henüz hiç bir form create edilmeden çalışmakta, bu sebeple killapp fonksiyonda belirtilen scaption alanı
yazabileceğiniz bir değere ihtiyaç var(örneğin; form1.caption), bu sebeplede kill çalışmaz,

HWND FindWindowA(
  [in, optional] LPCSTR lpClassName,
 [in, optional] LPCSTR lpWindowName
);

caption yerine paramstr(0) ile full path karşılaştırılması yapılarak terminate edilmesi daha iyi olabilir.

AppHandle değerine (-1) bakılmakdan openprocess yapılmasıda yanlış olmuş.

[Hayati]

Konunun başlığı ile alakalı, içeriği ile alakasız ama katkı olsun diye eklemek isterim...

uses shellapi;

procedure TForm1.FormShow(Sender: TObject);
var atom : integer;
CRLF : string;
begin
   if GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then
   atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')

else
begin
   CRLF := #10 + #13;
   ShowMessage('Bu uygulama her Windows oturumunda yalnızca bir kere çalışır.' + CRLF +
   'Programı tekrar çalıştırmak için Windowsu restart edin. ');
   Close;

end;
end;

[mcuyan]

Aslında benim tam olarak istediğim şu: Ben yeni uygulamayı açarken: Uygulama zaten açık eski uygulama kapatılsın mı sorusu.. Bunun içibde eski açık olan uygulamanın PID değerini bulmak gerekiyor sanırım.. onu kill etmek lazım.

[QuAdR]

//uses TLHelp32;

var
myPID: THandle;
Mutex: THandle;

function GetPIDbyProcessName(processName: String): integer;
var
  tHnd: THandle;
  pEntry: tProcessEntry32;
begin
  Result := 0;
  tHnd := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  pEntry.dwSize := SizeOf(pEntry);
  if Process32First(tHnd, pEntry) then
  begin
    while Process32Next(tHnd, pEntry) do
    if (pEntry.szExeFile = processName) and  (pEntry.th32ProcessID <> GetCurrentProcessId) then
    begin
      Result := pEntry.th32ProcessID;
      Break;
    end;
  end;
  CloseHandle(tHnd);
end;


procedure KillApp(PidApp: integer );
var
 AppHandle:THandle;
begin
  AppHandle := OpenProcess(PROCESS_ALL_ACCESS,False,PidApp);
  if AppHandle > 0 then
  TerminateProcess(AppHandle,0);
  CloseHandle(AppHandle)
end;

begin
Application.Initialize;
Mutex := CreateMutex(nil , False, pchar(ExtractFileName(Application.ExeName)));
if GetLastError = ERROR_ALREADY_EXISTS then
begin
  if messagedlg('Açık olan programı kapatmak istiyormusunuz?', mtError, mbOKCancel, 0) = 1 then
   begin
      myPID := GetPIDbyProcessName(ExtractFileName(ParamStr(0)));      
      if myPID > 0 then
      begin
        KillApp(myPID)
      end;
   end
  else
     ExitProcess(0);
end;

Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.