Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

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

 
Влад_   (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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.059 c
2-1340704805
ford
2012-06-26 14:00
2013.03.22
проверить переменную типа Variant


15-1329424202
Юрий
2012-02-17 00:30
2013.03.22
С днем рождения ! 17 февраля 2012 пятница


2-1328101281
sergeii01
2012-02-01 17:01
2013.03.22
Запись в файл из нескольких потоков


2-1331807216
selesasha
2012-03-15 14:26
2013.03.22
Поиск в массиве


2-1331645587
Сергей
2012-03-13 17:33
2013.03.22
Компонент Delphi для Clob Oracle?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский