Läuft ein bestimmtes Programm bereits?

[CalganX]

Folgende Funktion stammt von unserem ehemaligem User Daniel B..

Mit dieser Funktion lässt sich herausfinden, ob ein bestimmtes Programm bereits läuft.

Delphi-Quellcode:

uses {...}, TlHelp, PsAPI;

// ...

procedure CreateWin9xProcessList(List: TStringList); 
var 
  hSnapShot: THandle; 
  ProcInfo: TProcessEntry32; 
begin 
  if List = nil then 
    Exit; 
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
  if (hSnapShot <> THandle(-1)) then 
  begin 
    ProcInfo.dwSize := SizeOf(ProcInfo); 
    if (Process32First(hSnapshot, ProcInfo)) then 
    begin 
      List.Add(ProcInfo.szExeFile); 
     while (Process32Next(hSnapShot, ProcInfo)) do 
       List.Add(ProcInfo.szExeFile); 
    end; 
    CloseHandle(hSnapShot); 
  end; 
end; 

procedure CreateWinNTProcessList(List: TStringList); 
var 
  PIDArray: Array[0..1023] of DWORD; 
  cb: DWORD; 
  i: integer; 
  ProcCount: integer; 
  hMod : HMODULE; 
  hProcess: THandle; 
  ModuleName: Array[0..300] of Char; 
begin 
  if List = nil then 
    Exit; 
  EnumProcesses(@PIDArray, sizeof(PIDArray), cb); 
  ProcCount := cb div SizeOf(DWORD); 
  for i := 0 to ProcCount -1 do 
  begin 
    hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or 
      PROCESS_VM_READ, False, PIDArray[I]); 
    if (hProcess <> 0) then 
    begin 
      EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb); 
      GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName)); 
      List.Add(ModuleName); 
      CloseHandle(hProcess); 
    end; 
  end; 
end; 

procedure GetProcessList(var List: TStringList); 
var 
  ovi: TOSVersionInfo; 
begin 
  if List = nil then 
    Exit; 
  ovi.dwOSVersionInfoSize := sizeof(TOSVersionInfo); 
  GetVersionEx(ovi); 
  case ovi.dwPlatformId of 
    VER_PLATFORM_WIN32_WINDOWS : CreateWin9xProcessList(List) ; 
    VER_PLATFORM_WIN32_NT : CreateWinNTProcessList(List) ; 
  end 
end; 

function IsEXERunning(sFileName: String; bFullpath: Boolean): Boolean; 
var 
  i: Integer; 
  MyProcList: TStringList; 
begin 
  MyProcList := TStringList.Create; 
  try 
    GetProcessList(MyProcList) ; 
    Result := False; 
    if MyProcList = nil then 
      Exit; 
    for i := 0 to MyProcList.Count -1 do 
    begin 
      if not bFullpath then 
      begin 
        if CompareText(ExtractFileName(MyProcList.Strings[i]), sFileName) = 0 then 
          Result := True 
        end else 
        if CompareText(MyProcList.Strings[i], sFileName) = 0 then 
          Result := True; 
        if Result then 
          Break; 
    end; 
  finally 
    FreeAndNil(MyProcList); 
  end; 
end; 

// Anwendungsbeispiel

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if IsEXERunning('delphi32.exe', False) then 
    ShowMessage('Läuft schon... *bääh*') 
  else 
    ShowMessage('Läuft nicht... :-)'); 
end;