Autor Beitrag
hitstec
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 295



BeitragVerfasst: Di 16.07.02 13:08 
Folgende Funktion wurde mit Delphi 5 Pro auf Win98SE und WinXP Home erfolgreich getestet. Unter uses müssen die Einträge TLHelp32 und PsAPI vermerkt werden.

Die Funktion erwartet als Eingabe einen String. Der String enthält entweder einen Namen oder Pfad+Name einer Anwendung. Als Rückgabewert ist ein boolscher Operator definiert. Wenn die Funktion true zurückgibt, dann wurde mindestens eine Instanz der Anwendung beendet.

Die Funktion unterscheidet zwischen NT und WIN9x und reagiert dann entsprechend.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
function TerminateEXE(sFile: string): Bool;
var 
  verSystem: TOSVersionInfo; 
  hdlSnap, hdlProcess: THandle; 
  bPath, bLoop: Bool;
  peEntry: TProcessEntry32; 
  arrPid: array [0..1023of DWord; 
  iC: DWord;
  i,iCount: Integer; 
  arrModul: array [0..299of Char; 
  hdlModul: HMODULE;
begin
  result := false;
  if ExtractFileName(sFile)=sFile then 
    bPath:=false 
  else 
    bPath:=true;
  verSystem.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(verSystem);
  if verSystem.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
    hdlSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
    peEntry.dwSize:=Sizeof(peEntry);
    bLoop:=Process32First(hdlSnap,peEntry);
    while integer(bLoop)<>0 do 
    begin
      if bPath then 
      begin
        if CompareText(peEntry.szExeFile,sFile)=0 then 
        begin
          TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID),0);
          result:=true;
        end;
      end 
      else 
      begin
        if CompareText(ExtractFileName(peEntry.szExeFile),sFile)=0 then 
        begin
          TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,peEntry.th32ProcessID),0);
          result:=true;
        end;
      end;
      bLoop:=Process32Next(hdlSnap,peEntry);
    end;
    CloseHandle(hdlSnap);
  end 
  else
  begin
    if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then 
    begin
      EnumProcesses(@arrPid,SizeOf(arrPid),iC);
      iCount:=iC div SizeOf(DWORD);
      for i:=0 to Pred(iCount) do 
      begin
        hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid[i]);
        if (hdlProcess<>0then 
        begin
          EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC);
          GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul));
          if bPath then 
          begin
            if CompareText(arrModul,sFile)=0 then 
            begin
              TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid[i]), 0);
              result:=true;
            end;
          end 
          else 
          begin
            if CompareText(ExtractFileName(arrModul),sFile)=0 then 
            begin
              TerminateProcess(OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,arrPid[i]), 0);
              result:=true;
            end;
          end;
          CloseHandle(hdlProcess);
        end;
      end;
    end;
  end;
end;

Aufgerufen wird sie z. Bsp. so:

ausblenden Delphi-Quelltext
1:
2:
3:
4:
procedure TForm1.Button1Click(Sender: TObject);
begin
 if TerminateEXE('notepad.exe'then ShowMessage('Anwendung beendet.');
end;

PS: Kann mal jemand testen ob die Funktion auf Windows NT funktioniert. Und ob Sie auch ohne Adminberechtigung funkt.

Moderiert von user profile iconjasocul: Source an Style-Guide angepasst