Текущий архив: 2013.03.22;
Скачать: CL | DM;

Вниз

Кол-во запущенных экземпляров программы   Найти похожие ветки 

← →
Влад_   (2012-04-22 12:07) [0]

Здравствуйте. Есть самописная функция, которая возвращает количество запущенных копий программы, но даже если запущена одна копия функция всегда возвращает 2. Не пойму в чем ошибка? Вот код:

function GetInsNum(const ExePath: string): Integer;
var
 hProcessSnap, hModuleSnap: THandle;
 pe32: PROCESSENTRY32;
 me32: MODULEENTRY32;
begin
 Result := 0;
 hProcessSnap := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 if hProcessSnap = INVALID_HANDLE_VALUE then
   Exit;
 pe32.dwSize := SizeOf(PROCESSENTRY32);
 me32.dwSize := SizeOf(MODULEENTRY32);
 if Process32First(hProcessSnap, pe32) then
 begin
   repeat
     hModuleSnap := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE, pe32.th32ProcessID);
     if hModuleSnap <> INVALID_HANDLE_VALUE then
     begin
       if Module32First(hModuleSnap, me32) then
         if lstrcmpi(me32.szExePath, PChar(ExePath)) = 0 then
           Inc(Result);
       CloseHandle(hModuleSnap);
     end;
   until not Process32Next(hProcessSnap,pe32);
 end;
 CloseHandle(hProcessSnap);
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
 ShowMessage(IntToStr(GetInsNum(ParamStr(0)))); // 2 ?
end;


---

← →
Влад_   (2012-04-22 12:13) [1]

В принципе, функцию можно было бы сделать булевой и ограничится проверкой:

...
Result := lstrcmpi(me32.szExePath, PChar(ExePath)) = 0;
...
until not Process32Next(hProcessSnap,pe32) or not Result;

Но просто интересно в чем ошибка

---

← →
KilkennyCat ©   (2012-04-22 12:19) [2]

ну дык запусти дебаггером

---

← →
Омлет ©   (2012-04-22 12:35) [3]

Не знаю, в чем ошибка, но вот эта работает верно (но начиная с NT или XP):

function GetInsNum2(const ExePath: string): Integer;
var
 I: Integer;
 ASize: DWORD;
 hMod: HMODULE;
 hProcess: THandle;
 PIDArray: array [0..1023] of DWORD;
 ModuleName: array [0..MAX_PATH] of Char;
begin
 Result := 0;
 if EnumProcesses(@PIDArray, SizeOf(PIDArray), ASize) then
 begin
   for I := 0 to ASize div SizeOf(DWORD) - 1 do
   begin
     hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PIDArray[I]);
     if hProcess <> 0 then
     try
       EnumProcessModules(hProcess, @hMod, SizeOf(hMod), ASize);
       GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
       if ModuleName = ExePath then
         inc(Result);
     finally
       CloseHandle(hProcess);
     end;
   end;
 end;
end;

---

← →
Омлет ©   (2012-04-22 12:37) [4]

А если надо просто ограничить запуск одной копией, то для этого есть мютексы - не надо все процессы перебирать. К тому же у вышеприведенного способа нет защиты от запуска двух копий из разных мест.

---

← →
Влад_   (2012-04-22 12:48) [5]

То, что такая проверка - не лучший вариант это понятно. Просто не понятно откуда берутся 2 копии, когда запущена 1. Ну да ладно, будем считать, что это такая особенность системы)

---

← →
begin...end ©   (2012-04-22 13:31) [6]

> Влад_   (22.04.12 12:07)

repeat
  if pe32.th32ProcessID = 0 then
    Continue;
  ...
until not Process32Next(hProcessSnap, pe32)

---

Страницы: 1 вся ветка

Текущий архив: 2013.03.22;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.078 c