Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1104
  • Last Modified:

Allow one instance of a process to run

Greetings

I have some backend process that supports the functionality of my program.
Unfortunately I can launch as many of these processes as I want to.

If for example process "A" is running, I do not want to be able to launch that process again and have two or more of them running at the same time.

Avoiding multiple instances of an APPLICATION seems to be no problem, but I cant seem to accomplish the same for my processes.

Any help / pointers will be greatly appreciated.

Regards
 Engwi
0
Engwi
Asked:
Engwi
  • 7
  • 2
1 Solution
 
snehanshuCommented:
Does this help?

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20370389.html

Accepted Answer from MBo
Date: 10/09/2002 07:47AM IST
 Accepted Answer  

This method works for Win9X, 2K, XP.
For NT use PSAPI, EnumProcesses
Another way - NTQuerySystemInformation

procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 Snapshot: THandle;
 PE: TProcessEntry32;
begin
 ListBox1.Clear;
 Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 if (Snapshot = DWORD(-1)) then
     Exit;
 PE.dwSize := SizeOf(TProcessEntry32);
 if Process32First(Snapshot, PE) then
 repeat
   I := ListBox1.Items.Add(PE.szExeFile);
 until not Process32Next(Snapshot, PE);
 CloseHandle (Snapshot);
end;

...Snehanshu
0
 
EngwiAuthor Commented:
snehanshu

Thanks for the comment. How do I positively identify NT ?? The methods I have will place win 2000 and NT under the same category ?

Regards
 Engwi  
0
 
snehanshuCommented:
Engwi,
I did not "know" the answer to both your questions. But thanks to the premium services, here's a link:

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20274797.html
:-)

...Snehanshu

Accepted Answer from Stuart Johnson
Date: 03/11/2002 08:10AM IST
 Accepted Answer  

function GetSystemType: Integer;
const
  { operating system constants }
  cOsUnknown = -1;
  cOsWin95 = 0;
  cOsWin98 = 1;
  cOsWin98SE = 2;
  cOsWinME = 3;
  cOsWinNT = 4;
  cOsWin2000 = 5;
  cOsWinXP = 6;

var
  osVerInfo : TOSVersionInfo;
  majorVer, minorVer : Integer;

begin
  result := cOsUnknown;
{ set operating system type flag }
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then
    begin
      majorVer := osVerInfo.dwMajorVersion;
      minorVer := osVerInfo.dwMinorVersion;
      case osVerInfo.dwPlatformId of
        VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
          begin
            if majorVer <= 4 then
              result := cOsWinNT
            else
              if (majorVer = 5) AND (minorVer= 0) then
                result := cOsWin2000
              else
                if (majorVer = 5) AND (minorVer = 1) then
                  result := cOsWinXP
            else
            result := cOsUnknown;
          end; {case }
      VER_PLATFORM_WIN32_WINDOWS : { Windows 9x/ME }
        begin
          if (majorVer = 4) AND (minorVer = 0) then
            result := cOsWin95
          else
            if (majorVer = 4) AND (minorVer = 10) then
              begin
                if osVerInfo.szCSDVersion[1] = 'A' then
                  result := cOsWin98SE
                else
                   result := cOsWin98;
                end {if Version = 'A'}
              else
                if (majorVer = 4) AND (minorVer = 90) then
                  result := cOsWinME
                else
                   result := cOsUnknown;
        end; {case VER_PLATFORM_WIN32_WINDOWS}
      else
       result := cOsUnknown;
    end;
  end
else
   result := cOsUnknown;
end;



procedure TForm1.Button1Click(Sender: TObject);
const
  OSTypes: Array[-1..6] of String = ('Unknown','Windows 95','Windows 98',
    'Windows 98 SE','Windows ME','Windows NT 4.0','Windows 2000','Windows XP');

begin
  Showmessage('You are running '+OSTypes[GetSystemType]);
end;
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
EngwiAuthor Commented:
snehanshu

I used the following code in the past, obviously this gave me headaches in NT...

Procedure TForm1.RefreshProcesses;
 Var
  LibInst, hSnapShot, hProcess: THandle;
  SnapShot: TCreateToolhelp32Snapshot;
  ProcFirst: TProcess32First;
  ProcNext: TProcess32Next;
  ProcEntry1: TProcessEntry32;
 Begin
  ProcList.Clear;
  LibInst := LoadLibraryA('Kernel32.DLL');
 if LibInst = 0 then
   Begin
    ShowMessage('Big Trouble, this is not a windows system');
    Exit;
   end;
 try
 @Snapshot := GetProcAddress(LibInst, 'CreateToolhelp32Snapshot');
 if not Assigned(Snapshot) then
   Raise Exception.Create('Process address for CreateToolhelp32Snapshot not found. . . Window Sys Error is'+#10+
                         IntToStr(GetLastError));
 @ProcFirst := GetProcAddress(LibInst, 'Process32First');
 @ProcNext := GetProcAddress(LibInst, 'Process32Next');
 hSnapShot := Snapshot(TH32CS_SNAPPROCESS, 0);
 try
 if hSnapShot = 0 then
  ShowMessage(' no Snapshot, failure') else
  begin
  ProcEntry1.dwSize := sizeof(TProcessEntry32);
  if ProcFirst(hSnapShot, ProcEntry1) then
    Begin
    ProcList.Add(ProcEntry1.szExeFile);
    while ProcNext( hSnapShot, ProcEntry1 ) do
       ProcList.Add(ProcEntry1.szExeFile);
    end;
  end;
  finally
   CloseHandle(hSnapShot);
  end;
 Finally
  FreeLibrary(LibInst);
 end;
end;

Procedure X
 Var
   i : Integer;
 Begin
    .....................
  RefreshProcesses;
  For i := 0 to ProcList.Count - 1 do
   Begin
     Proc := ProcList.Strings[i];
     if Proc = 'TheName.exe' then IsThere := True;
    end;
   If IsThere = False then ShellExecute(Application.Handle,'Open',IePth,'','',SW_HIDE);
end;

This was my way of making sure that some other process was running.
Snapshot was created, iterated through processes, and launched if not active.

Regards
 Engwi
0
 
EngwiAuthor Commented:
Snehanshu

Thanks for your input. I will investigate and get back to you.

Regards
 Engwi
0
 
EngwiAuthor Commented:
Snehanshu

While we are on the subject , have a look at .....

http://www.online-admin.com/twmiprocesscontrol.html

Regards
 Engwi
0
 
SaLzCommented:
one instance of a application, this will work for you :)


procedure Tform1.FormCreate(Sender: TObject);
var
MutexHandle: THandle;

begin
MutexHandle := CreateMutex(nil, TRUE, PChar(form1));
if MutexHandle <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
      begin
        CloseHandle(MutexHandle);
        Halt;
      end;
   end
end;
0
 
EngwiAuthor Commented:
Slaz

Great stuff for an APP with a form. Not going to solve my problem on my processes.

Regards
 Engwi
0
 
EngwiAuthor Commented:
Salz

Great stuff for an APP with a form. Not going to solve my problem on my processes.

Regards
 Engwi
0
 
EngwiAuthor Commented:
Greetings

My Sollution is as follows ....

Win9X Win2000 WinXP (Using the WMI components from :
http://www.online-admin.com/twmiprocesscontrol.html)

Procedure TForm1.RefreshProcesses;
 Var
  LibInst, hSnapShot, hProcess: THandle;
  SnapShot: TCreateToolhelp32Snapshot;
  ProcFirst: TProcess32First;
  ProcNext: TProcess32Next;
  ProcEntry1: TProcessEntry32;
 Begin
  StringList.Clear;
  LibInst := LoadLibraryA('Kernel32.DLL');
 if LibInst = 0 then
   Begin
    ShowMessage('Big Trouble, this is not a windows system');
    Exit;
   end;
 try
 @Snapshot := GetProcAddress(LibInst, 'CreateToolhelp32Snapshot');
 if not Assigned(Snapshot) then
   Raise Exception.Create('Process address for CreateToolhelp32Snapshot not found. . . Window Sys Error is'+#10+
                         IntToStr(GetLastError));
 @ProcFirst := GetProcAddress(LibInst, 'Process32First');
 @ProcNext := GetProcAddress(LibInst, 'Process32Next');
 hSnapShot := Snapshot(TH32CS_SNAPPROCESS, 0);
 try
 if hSnapShot = 0 then
  ShowMessage(' no Snapshot, failure') else
  begin
  ProcEntry1.dwSize := sizeof(TProcessEntry32);
  if ProcFirst(hSnapShot, ProcEntry1) then
    Begin
    StringList.Add(ProcEntry1.szExeFile);
    while ProcNext( hSnapShot, ProcEntry1 ) do
       StringList.Add(ProcEntry1.szExeFile);
    end;
  end;
  finally
   CloseHandle(hSnapShot);
  end;
 Finally
  FreeLibrary(LibInst);
 end;
end;

Then, iterate through StringList and make sure there is only one instance running of my Process (By Name)

For Win NT, making use of PSAPI.dll ......

{Get handles to functions in the DLL}

 Procedure PrepareForNT;
 Var
  HandlePSAPI_DLL : THandle;
  Cnt,ForCnt      : Integer;
 Begin
   HandlePSAPI_DLL := LoadLibrary(cPSAPIDLL);
  If (HandlePSAPI_DLL <> 0) then //Where on NT/2000...
   Begin
    @EnumProcesses        := GetProcAddress(HandlePSAPI_DLL, 'EnumProcesses');
    @GetModuleFileNameExA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleFileNameExA');
    @EnumProcessModules   := GetProcAddress(HandlePSAPI_DLL, 'EnumProcessModules');
   end;
 end;

{Enumerate the Processes}

Procedure TForm1.GetProcessesOnNT;
 Var
  I : Integer;
  pidNeeded : DWORD;
  PIDList : array[0..1000] of Integer;
  PIDName : array [0..MAX_PATH - 1] of char;
  PH : THandle;
  hMod : HMODULE;
  dwSize2 : DWORD;

  J,
  ColBeforeRefresh : integer;
  PIDContentsBeforeRefresh : string;
Begin
  PrepareForNT;
  Perform(WM_SETREDRAW, 0, 0);
  If not EnumProcesses(@PIDList, 1000, pidNeeded) then
    raise Exception.Create('PSAPI.DLL not found! Are you sure you ' +
    'are running windows NT/Y2K ?');
    For i := 0 to (pidNeeded div SizeOf (Integer)- 1) do
      Begin
        PH := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
          FALSE, PIDList[I]);
        if PH <> 0 then
          begin
            if GetModuleFileNameExA(PH, 0, PIDName, SizeOf(PIDName)) > 0 then
              begin
                if EnumProcessModules(PH, @hMod, SizeOf(hMod), dwSize2) then
                  Begin
                    GetModuleFileNameExA(PH, hMod, PIDName, SizeOf(PIDName));
                    StringList.Add(ExtractFileName(PIDName));
                  end;
                 CloseHandle(PH);
              end;
          end;
      end;
   end;

Again, go through the list to determine if only one instance is running.

Thank you snehanshu. The links and info helped alot.

Regards
 Engwi  




0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 7
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now