Solved

Allow one instance of a process to run

Posted on 2003-11-12
10
1,089 Views
Last Modified: 2010-04-05
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
Comment
Question by:Engwi
  • 7
  • 2
10 Comments
 
LVL 5

Accepted Solution

by:
snehanshu earned 20 total points
ID: 9737478
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
 

Author Comment

by:Engwi
ID: 9737520
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
 
LVL 5

Expert Comment

by:snehanshu
ID: 9737561
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
 

Author Comment

by:Engwi
ID: 9737569
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
 

Author Comment

by:Engwi
ID: 9737581
Snehanshu

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

Regards
 Engwi
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:Engwi
ID: 9737729
Snehanshu

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

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

Regards
 Engwi
0
 
LVL 2

Expert Comment

by:SaLz
ID: 9739519
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
 

Author Comment

by:Engwi
ID: 9739574
Slaz

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

Regards
 Engwi
0
 

Author Comment

by:Engwi
ID: 9739580
Salz

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

Regards
 Engwi
0
 

Author Comment

by:Engwi
ID: 9740174
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now