Entwickler-Ecke

Windows API - externe Programme mit Delphi schliessen


tom1266 - Sa 04.01.03 16:55
Titel: externe Programme mit Delphi schliessen
Hallo Leute,

ich komme einfach nicht klar damit, dass es keine Möglichkeit gibt externe Programme mit Delphi zu schliessen zB Internetexplorer oder MS Outlook, hier sind wohl die Meister gefragt!!! :lol:

Über Hilfe würde ich mich freuen !


Gruß Tom


torstenheinze - Sa 04.01.03 17:13


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:
uses  
  Tlhelp32; 

function KillTask(ExeFileName: string): integer; 
const 
  PROCESS_TERMINATE=$0001;  
var 
  ContinueLoop: BOOL; 
  FSnapshotHandle: THandle; 
  FProcessEntry32: TProcessEntry32;  
begin 
  result := 0;  

  FSnapshotHandle := CreateToolhelp32Snapshot 
                     (TH32CS_SNAPPROCESS, 0);  
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32); 
  ContinueLoop := Process32First(FSnapshotHandle,  
                                 FProcessEntry32); 

  while integer(ContinueLoop) <> 0 do 
  begin 
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = 
         UpperCase(ExeFileName)) 
     or (UpperCase(FProcessEntry32.szExeFile) = 
         UpperCase(ExeFileName))) then 
      Result := Integer(TerminateProcess(OpenProcess( 
                        PROCESS_TERMINATE, BOOL(0), 
                        FProcessEntry32.th32ProcessID), 0));  
    ContinueLoop := Process32Next(FSnapshotHandle, 
                                  FProcessEntry32); 
  end;  

  CloseHandle(FSnapshotHandle);  
end



procedure TForm1.Button1Click(Sender: TObject); 
begin 
  KillTask('notepad.exe'); 
end;


Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


torstenheinze - Sa 04.01.03 17:14

hiermit kann man sich processe anzeigen lassen:

Wichtig ist die Einbindung der Unit TlHelp32

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:
interface 
uses 
 {...,}TLHelp32 {important !} 

// Global Variables, Globale Variablen 

VAR aSnapshotHandle : THandle; 
    aProcessEntry32 : TProcessEntry32; 

procedure TFormMain.BtnRefreshClick(Sender: TObject); 
var i       : integer; 
    bLoop   : BOOL; 
    NewItem : TListItem; 
begin 
  ListView.Items.Clear; 
  aSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); 
  aProcessEntry32.dwSize:=Sizeof(aProcessEntry32); 
  bLoop:=Process32First(aSnapshotHandle,aProcessEntry32); 
  while integer(bLoop) <>0 do 
  begin 
    NewItem:=ListView.Items.add; 
    NewItem.Caption:=ExtractFileName(aProcessEntry32.szExeFile); 
    NewItem.subItems.Add(IntToHex(aProcessEntry32.th32ProcessID,4)); 
    NewItem.subItems.Add(aProcessEntry32.szExeFile); 
    ContinueLoop:=Process32Next(aSnapshotHandle,aProcessEntry32); 
  end
  CloseHandle(aSnapshotHandle); 
end

procedure TFormMain.ListViewDblClick(Sender: TObject); 
var  Ret : BOOL; 
     PrID : integer; //processidentifier 
     Ph : THandle;  //processhandle 
begin 
  try 
    with ListView do 
    begin 
      if MessageDlg('Do you want to Terminate "'+ItemFocused.Caption+'"?'+^J+ 
                    'posible the system is instabile or out of'+^J+ 
                    'control......'
          mtConfirmation,[mbYes,mbNo],0)=mrYes then 
       begin 
         PrID:=StrToInt('$'+ItemFocused.SubItems[0]); 
         Ph:=OpenProcess(1,BOOL(0),PrID); 
         Ret:=TerminateProcess(Ph,0); 
         if Integer(Ret)=0 Then 
           MessageDlg('Can Not Terminate "'+ItemFocused.Caption+'"',mtInformation,[mbOk],0
         else 
           ItemFocused.Delete; 
       end
     end
   except 
   end
end

procedure TFormMain.FormCreate(Sender: TObject); 
begin 
  //Application.OnHint := DisplayHint;  //If you want/need it... 
  BtnRefreshClick(Sender); 
end;


Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


tom1266 - Sa 04.01.03 17:55

Hallo Torsten, mit notepad klappt es super, aber mit anderen Programmen leider wieder nicht, versuchs mal mit MS Outlook.

:cry: :wink:

Gruß Tom


torstenheinze - Sa 04.01.03 18:00

warum denn nicht bei den anderen?
was kommt den da für ein fehler?
vieleicht darf es feine datei mit einem lehrzeichen im namen sein!
:(

tut mir leid das es nicht klappt


torstenheinze - Sa 04.01.03 18:02

vieleicht weil sich bei outlock die überschrift ändert, und somit auch der eintrag in dem taskmanager.
obwohl bei notpad ist das ja auch so


tom1266 - Sa 04.01.03 18:09

Fehler kommt keiner es passiert aber nichts. Das Programm geht nicht zu.


torstenheinze - Sa 04.01.03 18:13

merkwürdig :!: :!: :!: :?
ich weiß leider nicht weiter


tom1266 - Sa 04.01.03 20:05

Danke alles OK, dein Skript ist schon OK du hast mir sehr geholfen!!


Klabautermann - Sa 04.01.03 20:47

Hallo,

bitte halte dich an die richtlinien.

AUQ! - Richtlinien hat folgendes geschrieben:
1.1 Beiträge

Bitte formuliere den Betreff Deiner Beiträge so, dass andere Mitglieder anhand dieser bereits das eigentliche Thema festmachen können. Beiträge wie etwa "Eine Anfängerfrage" oder "Weiß jemand, wie das geht?" lassen den Leser im Unklaren darüber, was das Thema der Diskussion ist. Eine Pseudocodezeile oder die Nennung des Objektes, um welches es sich in dem Beitrag handelt, helfen da schon mehr weiter.


Gruß
Klabautermann


tom1266 - Mo 06.01.03 09:30

HAllo,

habe das Script nun mal mit NT4 probiert leider Fehlanzeige, nun ich bräuchte es für NT4, auf 2000 und XP läuft es!!

Gruß Tom


Delete - Mo 06.01.03 09:47

NT kennt die Toolhelp.dll nicht. Das Entwicklerteam hat sich damals aus unerfindlichen Gründen dazu entschlossen alles neu zu schreiben und in die PSAPI.dll zu packen.

Aber Assarbad arbeitet daran, siehe hier: http://www.assarbad.org/de/index.shtml

Auch wenn ihr es jetzt schon gelöst habt, will ich meine Version noch mal in den Topf schmeißen. Besondere Beachtung sollte der Prozedur KillProcess mit WaitForSingleObject geschenkt werden. Aber bitte vorsicht beim Debuggen, wenn man einen Prozess erwischt, der sich nicht beenden läßt, da scheint WaitForSingleObject etwas buggy zu sein. In der fertig kompüilierten Exe geht alles wunderbar.


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:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
uses
  tlhelp32;

{******************************************************************************}
{**                                                                          **}
{** Prozesse in Stringliste schreiben                                        **}
{**                                                                          **}
{******************************************************************************}
procedure GetProcessList(sl: TStrings);
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  { Snapshot machen *PENG* }
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;

  pe32.dwSize := SizeOf(ProcessEntry32);

  { wenn es geklappt hat }
  if Process32First(hProcSnap, pe32) = true then
    { und los geht's }
    { Process32First liefert auch schon einen Prozess, den System-Prozess }
    sl.Add(pe32.szExeFile);
    while Process32Next(hProcSnap, pe32) = true do
    begin
      sl.Add(pe32.szExeFile);
    end;
  CloseHandle(hProcSnap);
end;

{******************************************************************************}
{**                                                                          **}
{** ProzessID an Hand der Exe-Datei ermittlen                                **}
{**                                                                          **}
{******************************************************************************}
function GetProcessID(sProcName: String): Integer;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  result := -1;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;

  pe32.dwSize := SizeOf(ProcessEntry32);

  { wenn es geklappt hat }
  if Process32First(hProcSnap, pe32) = true then
    { und los geht's: Prozess suchen}
    while Process32Next(hProcSnap, pe32) = true do
    begin
      if pos(sProcName, pe32.szExeFile) <> 0then
        result := pe32.th32ProcessID;
    end;
end;

{******************************************************************************}
{**                                                                          **}
{** Prozess beenden                                                          **}
{**                                                                          **}
{******************************************************************************}
procedure KillProcess(dwProcID: DWORD);
var
  hProcess : Cardinal;
  dw       : DWORD;
begin
  { open the process and store the process-handle }
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, dwProcID);
  { kill it }
  TerminateProcess(hProcess, 0);
  { TerminateProcess returns immediately, so wie have to verify the result via
    WaitForSingleObject }

  dw := WaitForSingleObject(hProcess, 5000);
  case dw of
    { everythings's all right, we killed the process }
    WAIT_OBJECT_0: Messagebox(Application.Handle, 'Prozess wurde beendet.''Prozess beenden',
      MB_ICONINFORMATION);
    { process could not be terminated after 5 seconds }
    WAIT_TIMEOUT:
    begin
      Messagebox(Application.Handle, 'Prozess konnte nicht innerhalb von 5 Sekunden beendet werden.',
        'Prozess beenden', MB_ICONSTOP);
      exit;
    end;
    { error in calling WaitForSingleObject }
    WAIT_FAILED:
    begin
      RaiseLastOSError;
      exit;
    end;
  end;
  { and refresh listbox contend }
  Form1.Button1Click(Form1);
end;

{******************************************************************************}
{**                                                                          **}
{** Button zum Auflisten der Prozesse und in Listbox schreiben               **}
{**                                                                          **}
{******************************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
begin
  Listbox1.Clear;
  GetProcessList(Listbox1.Items);
end;

{******************************************************************************}
{**                                                                          **}
{** Button zum Prozess beenden                                               **}
{**                                                                          **}
{******************************************************************************}
procedure TForm1.Button2Click(Sender: TObject);
begin
  KillProcess(GetProcessID(Listbox1.Items.Strings[Listbox1.ItemIndex]));
end;


@thorstenheinze: Was sollen die globalen Variablen in deinem Code? :shock:

Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


tom1266 - Mo 06.01.03 09:55

Hallo Luckie, jetzt nochmal für mich als Anfänger, was kann ich tun...?


Delete - Mo 06.01.03 10:00

Entweder daraufwarten bis Assarbad fertig ist. (Das kann aber etwas dauern. Stell dich drauf ein, dass deine Enkel dann das Programm endlich benutzen können.) Oder selber versuchen es hinzubekommen mit der PSAPI. Delphi liefert dazu sogar eine Unit: PSAPI.pas, in der die Callback EnumProcesses drin ist. Damit sollte es also gehen.


tom1266 - Mo 06.01.03 10:04

Danke Luckie für deine Bemühung.

Gruß Tom


Boldar - Sa 27.12.08 14:29

mmh Ich möchte einen Pozess killen, von dem ich ein Fensterhandle weiss. Wie geht das?
[Ich weiss das der thread uralt is, aber ich wollte nich extra einen neuen erstellen...]


jaenicke - Sa 27.12.08 15:01

Sende WM_CLOSE an das Handle, vielleicht funktioniert das bereits, das kommt darauf an von was das Handle ist.


Boldar - Sa 27.12.08 15:10

mmh vom wmp... ja das könnte gehen... danke!


Boldar - Sa 27.12.08 19:34

mmh nee geht doch nicht. Also es ist der WMP... Also im Prinzip will ich einfach alle laufenden WMP-Instanzen killen. Geht das irgendwie einfach?


jaenicke - Sa 27.12.08 19:37

Dann nimm doch einfach den fertigen Code dafür, den user profile iconLuckie oben gepostet hat: :nixweiss:
http://www.delphi-forum.de/viewtopic.php?p=27892#27892
Schließlich brauchst du dann das Fensterhandle ja nicht, wenn es um alle geht.


Boldar - Sa 27.12.08 19:39

mmh stimmt nun auch wieder...


Boldar - Sa 27.12.08 19:40

Aber ich merke gerade: ich habe ne Konsolenanwendung und deshalp gibt es application.handle nicht...
edith: aso das kann ich ja streichen, is ja nur ne showmessage...


jaenicke - Sa 27.12.08 19:42

Meistens geht aber einfach 0, weil der Befehl sich eben auf kein Fenster deiner Anwendung beziehen soll. Der Grund weshalb man das angibt ist ja z.B. bei einer MessageBox, damit der Besitzer der Box auf das angegebene Fenster gesetzt wird.
Gibst du 0 an, dann gibt es eben keinen Besitzer.


Boldar - Sa 27.12.08 19:50

Also, es geht trotzdem nicht. Obwohl die PID > 0 ist, bekomme ich die Fehlermeldung, das Handle sei ungültig.


jaenicke - Sa 27.12.08 20:03

user profile iconBoldar hat folgendes geschrieben Zum zitierten Posting springen:
Also, es geht trotzdem nicht.
Das kann ich mit Luckies Code nicht reproduzieren. :nixweiss:
Bei mir wird der WMP geschlossen, egal ob er gerade minimiert, in der Taskleiste als Miniplayer oder sichtbar ist.


Boldar - Sa 27.12.08 20:03

Und noch nichtmal das da geht: http://www.swissdelphicenter.ch/de/showcode.php?id=266


jaenicke - Sa 27.12.08 20:07

Auch das funktioniert bei mir. :nixweiss:
Hast du vielleicht einen Tippfehler im Namen der Exe?

Welche Version vom WMP nutzt du? Welche Windowsversion? Wie sieht dein Code beim Aufrufen aus?

Angehängt habe ich user profile iconLuckies Code als Exe, mit nur einem Button, der den nächstbesten laufenden WMP versucht zu killen.


Boldar - Sa 27.12.08 20:09

mmh das geht wunderbar... aber was machst du anders? Welchen Dateinamen nimmst du denn?

btw: ouch... projekt 105... Wie wohl dein Projektverzeichniss aussieht... bestimmt schon über 20GB


jaenicke - Sa 27.12.08 20:11

Das ist user profile iconLuckies Code [http://www.delphi-forum.de/viewtopic.php?p=27892#27892] mit folgender Zeile:

Delphi-Quelltext
1:
  KillProcess(GetProcessID('wmplayer.exe'));                    
Die Auflistung und so hab ich einfach rausgenommen.


Boldar - Sa 27.12.08 20:16

mmh naja jetzt kenn ich den Fehler... ich hab den kompletten Dateipfad angegeben... ein
extractfilename und es läuft... :autsch:

Moderiert von user profile iconNarses: Smilietis kuriert


jaenicke - Sa 27.12.08 20:25

Wozu das? Der WMP heißt doch immer gleich. :gruebel:

Btw.:
user profile iconBoldar hat folgendes geschrieben Zum zitierten Posting springen:
btw: ouch... projekt 105... Wie wohl dein Projektverzeichniss aussieht... bestimmt schon über 20GB
Im Standardverzeichnis für automatisches Speichern bei F9 sinds 1146 Dateien und 67 Ordner (in die Ordner hab ich mal etwas einsortiert, meistens mit der entsprechenden Topic-ID aus dem Forum dabei :D), insgesamt sinds 3750 Dateien in 347 MiB. :D
Und meine Partition rein mit Quelltexten und Projekten (eigene und heruntergeladene) enthält genau 40,9 GiB in 398.982 Dateien und 29.074 Ordnern. :D


Boldar - Sa 27.12.08 20:32

OMG