Process_Terminate funktioniert nicht

[speedy]

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetProcessID(sProcName: String): Integer;      //ProzessID an Hand der exe-Datei ermitteln
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) <> 0 then
        result := pe32.th32ProcessID;
    end;
end;


procedure KillProcess(dwProcID: DWORD);        // Prozess abschießen
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
    WAIT_TIMEOUT: exit;
    WAIT_FAILED: exit;
  end;
end;


procedure KillProcess2(const dwProcID, dwTimeOut: DWORD);
var
  hProcess, Size,
  WrittenBytes, TID,
  hThread, ExitCode: DWord;
  Memory: Pointer;
  procedure _injectedCode_ExitProcess(P: Pointer); stdcall;
  type
    TExitProcess = procedure(uExitCode: UINT); stdcall;
  begin
    TExitProcess(P)(0);
  end;
  procedure _injectedCode_End();
  asm
    ret
  end;

begin
  hProcess := OpenProcess( GENERIC_WRITE, False, dwProcID );
  if hProcess <> ERROR then
    try
      Size := DWord( @_injectedCode_End ) - DWord( @_injectedCode_ExitProcess );
      Memory := VirtualAllocEx( hProcess, NIL, Size, MEM_COMMIT, PAGE_EXECUTE_READWRITE );
      if Assigned( Memory ) then
        try
          WriteProcessMemory( hProcess, Memory, @_injectedCode_ExitProcess, Size, WrittenBytes );
          if WrittenBytes = Size then
          begin
            hThread := CreateRemoteThread( hProcess, NIL, 0, Memory, GetProcAddress( GetModuleHandle( 'kernel32.dll' ), 'ExitProcess' ),
              0, TID );
            if hThread <> ERROR then
              WaitForSingleObject( hThread, dwTimeOut );
          end;
        finally
          VirtualFreeEx( hProcess, Memory, Size, MEM_DECOMMIT );
        end;
    finally
      CloseHandle( hProcess );
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var pid:integer;

begin
  //ggf. killprocess2 durch killprocess ersetzen um andere Methode zu probieren

  pid := getprocessid('metin2.bin');
  if pid <> -1 then killprocess2(pid,5000);

  pid := getprocessid('metin2client.bin');
  if pid <> -1 then killprocess2(pid,5000);

  pid := getprocessid('metin2.exe');
  if pid <> -1 then killprocess2(pid,5000);

end;

end.

[Luckie]

Also wenn du sowieso die Routine verlässt, egal, was passiert, dann kannst du diesen Code

Delphi-Quellcode:

  dw := WaitForSingleObject(hProcess, 5000);
  case dw of
    WAIT_TIMEOUT: exit;
    WAIT_FAILED: exit;
  end;

auch weglassen. Und was ist aus dem Rest von meinem Code geworden? Die Fehlerbhandlung habe ich da nicht zum Spaß implementiert. :roll:

[speedy]

Naja wenn das Programm versteckt im Hintergrund laufen soll, wäre ne Messagebox etwas auffällig ;)

[Luckie]

Die kann man ja später rausnehmen. Aber ist dir der Gedanke schon mal gekommen, dass die Fehlermeldungen auch dir helfen könnten?

[speedy]

Jetzt wo du's sagst :roll:

[Assarbad]

Ich habe es eben probiert. Folgender Code:

Delphi-Quellcode:

program killmetin2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  TlHelp32,
  Windows;

function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL;
  const NewState: TTokenPrivileges; BufferLength: DWORD;
  PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
  external 'advapi32.dll' name 'AdjustTokenPrivileges';

function SetProcessPrivilege(const Enable: Boolean;
  const Privilege: string): Boolean;
const
  PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED);
var
  Token: THandle;
  TokenPriv: TTokenPrivileges;
begin
  Result := False;
  if (not OpenThreadToken(GetCurrentThread(), TOKEN_ADJUST_PRIVILEGES, True,
    Token)) then
    WriteLn('Could not open thread token');
    if (not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES,
      Token)) then
    begin
      WriteLn('Could not open process token');
      SetLastError(ERROR_INVALID_HANDLE);
      exit;
    end;
  WriteLn('Got token');
  TokenPriv.PrivilegeCount := 1;
  LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid);
  TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable];
  Result := AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil);
  if(not Result) then
  begin
    WriteLn('Failed to set ', Privilege, ' privilege');
  end;
  CloseHandle(Token);
end;

function GetProcessID(sProcName: String): DWORD;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  Result := 0;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap <> INVALID_HANDLE_VALUE then
  begin
    try
      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) <> 0 then
          begin
            Result := pe32.th32ProcessID;
            WriteLn('Found process as ID: ', Result);
            break;
          end;
        end;
    finally
      CloseHandle(hProcSnap);
    end;
  end
  else
  begin
    WriteLn('Failed to create snapshot');
  end;
end;

procedure KillProcess(dwProcID: DWORD);
var
  hProcess: THandle;
begin
  if(SetProcessPrivilege(True, 'SeDebugPrivilege')) then
  try
    hProcess := OpenProcess(PROCESS_TERMINATE, False, dwProcID);
    if(0 <> hProcess) then
    begin
      if(TerminateProcess(hProcess, 0)) then
        WriteLn('Terminated process')
      else
        WriteLn('Failed to terminate process, error ', GetLastError());
    end
    else
      WriteLn('Failed to open process handle, error ', GetLastError());
    CloseHandle(hProcess);
  finally
    SetProcessPrivilege(False, 'SeDebugPrivilege');
  end;
end;

begin
  try
     KillProcess(GetProcessID('metin2client.bin'));
     WriteLn('Press ENTER to quit');
     ReadLn;
  except
    //on E: Exception do
      //Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Ich bekomme kein Prozeßhandle und GetLastError zeigt mir Fehler 5 (Zugriff verweigert). Da sind also 100% irgendwelche Hooks im Spiel die das verhindern.

Der Task Manager benutzt ja ein paar der nativen APIs und irgendeine TS-Funktion zum Killen von Prozessen, wenn ich mich recht erinnere.

Code:

Found process as ID: 3848
Could not open thread token
Got token
Failed to open process handle, error 5
Could not open thread token
Got token
Press ENTER to quit

[speedy]

Ja, wie vermutet.

Dann ist das Ganze wohl ziemlich aussichtlos.

Darf ich fragen wie lange du für das Programm gebraucht hast? Glaub ich wär da locker nen halben Tag dran gesessen ;)

[Luckie]

Das zeitaufwändigste war bei ihm wohl das Tippen. Probiere aus, wie lange du brauchst, um das abzutippen und du weißt, wie lange er ungefähr gebraucht hat. Den Copy- und Paste-Code kannst du vernachlässigen. ;)

[speedy]

Ja, wenn man mal mehr Zeit hätte den Kram vernünftig zu lernen :coder:

[Luckie]

Er hat auch alles durch Selbststudium gelernt. Studiert hat er irgend so ein Ökozeugs. ;)