Programın 1 tane çalışması..

[Sawyer]

Arkadaşlar ben programımdan 1 tane çalışmasını istiyorum yani çalıştığı anda tekrar çift tıkladığımızda zaten çalışıyor demesini istiyorum.

Createmutex ile yaptım ancak mesala bilgisayarımda 2 tane kullanıcı var bunu kapatmadan kullanıcı değiştir ile diğer oturuma girip programımı çalıştırabiliyorum. Bunu nasıl engellerim?

Yardımlarınız için teşekkürler.

[conari]

Ana form create de

Kod: Tümünü seç

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 şu an da çalışıyor, Kontrol ediniz..');
Halt;
  end;

[Sawyer]

yok kardeş aynı oturumdan deneyince çalışıyorda, burdaki oturumu kapatmadan başka oturuma geçiyorum yani başka kullanıcıya geçiyorum açılıyor sorunsuz.

[Lost Soul]

oturumlar birbirinden bağımsız çalışır. bir oturumdan diğerine müdahle edemeyeceğiniz için bunu da engellemeyezsiniz diye düşünüyorum.

[Sawyer]

yapanı gördüm + ilave olarak process explorer diye bir program var onunla bütün oturumlarda çalışan programları listeliyor. buda demek oluyorki müdahaleden fazlası yapılıyor.

Yardımlarınızı bekliyorum...

[conari]

Task Manegar da gösteriyor.
Buradan belki Kill edersiniz öncekini.

[quadr]

çalışan processleri tara aynı isimde çalışan process var ise terminate et.

Kod: Tümünü seç

var
  ExeName: string;
  MyHandle: Thandle;
  Struct: TProcessEntry32;
begin
 ExeName := 'Program exe ismi';
  MyHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize := Sizeof(TProcessEntry32);
  while Process32Next(Myhandle, Struct) do
  begin
    if AnsiContainsStr(UpperCase(Struct.szExeFile), UpeerCase(ExeName)) = true then //Exe ismine bakalım
    begin
       ShowMessage('Program açık durumda');
       ExitProcess(0);
       Break;   
    end;

  end;

kolay gelsin...

[Sawyer]

Teşekkür ederim.. Kodu şu şekilde düzenledim ve sorunsuz çalışıyor çok sağol.

Kod: Tümünü seç

var
  ExeName: string;
  MyHandle: Thandle;
  Struct: TProcessEntry32;
  kopek:integer;
begin
kopek:=0;
ExeName := 'Project1.exe';

  MyHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize := Sizeof(TProcessEntry32);

  while Process32Next(Myhandle, Struct) do


  begin

    if  AnsiContainsStr(UpperCase(Struct.szExeFile), UpperCase(ExeName)) = true then //Exe ismine bakalım

    begin
         kopek:=kopek+1;
         if kopek > 1 then begin
       ShowMessage('Program açık durumda');
       ExitProcess(0);
       Break;
       end;
    end;
    end;

[quadr]

sora sora bağdat bulunur misali sora sora bitirecen programı.

[askarad]

USES kısmına eklenenmesi gereken bir sınıf var mı?

[sabanakman]

uses TlHelp32, StrUtils;

[Shou]

Merhabalar bu kodları kullanıyorumda şimdi burada bir açık var adam exe ismini değişip açabiliyor program oto exe ismini kontrol etsin yapamazmıyız?

[ALUCARD]

o zaman exenin ismini manuel yazmak yerine

Kod: Tümünü seç

ExtractFileName(Application.ExeName)

komutu ile al ve değişkene ata

[Shou]

Kod: Tümünü seç

var
  ExeName: string;
  MyHandle: Thandle;
  Struct: TProcessEntry32;
  kopek:integer;
begin
kopek:=0;
ExeName := 'Project1.exe';

  MyHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize := Sizeof(TProcessEntry32);

  while Process32Next(Myhandle, Struct) do


  begin

    if  AnsiContainsStr(UpperCase(Struct.szExeFile), UpperCase(ExeName)) = true then //Exe ismine bakalım

    begin
         kopek:=kopek+1;
         if kopek > 1 then begin
       ShowMessage('Program açık durumda');
       ExitProcess(0);
       Break;
       end;
    end;
    end;

ne dediğinizi anlamadımda burada örnek gösterirmisiniz?

[sabanakman]

İp ucu..:

Kod: Tümünü seç

ExeName := 'Project1.exe';

satırına müdaheleniz yeterli olacaktır..