VPF::Не могу удалить EXE файл после Debug API

vertex_ua

Дата 25.4.2007, 19:13 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 25.4.2007

Репутация: нет
Всего: нет

Добрый день. Пишу код, который сам компилирует другую программу компилятором dcc32 и запускает ее на выполнение. При этом не дает ей работать дольше чем 4000 мс. После работы программы возвращются строки good, not compiled, runtime или timeout. При первом щелчке на кнопке получаю значение good. То-есть программа скомпилировалась, была запущена и отработала за допустимый период времени. При втором щелчке программа выводит not compiled. Проблема в том, что первый раз программа закончила стою работу, ее уже нет в списке задач, но по неизвестной причине Windows запрещает модфикацию EXE файла, поэтому компилятор не может завершить компиляцию. Помогите, пожалуйста, если вам знакома эта проблема. Привожу код

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TProgramResult = record
  TimeoutFailed: boolean;
  RuntimeError: boolean;
  RuntimeErrorCode: Cardinal;
  ReturnResult: Cardinal;
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function RunProgram(CmdLine: String; Timeout: Cardinal):TProgramResult;
var
  tick, eCode: Cardinal;
  si: TStartupInfo;
  pi: TProcessInformation;
  dbg: _DEBUG_EVENT;
begin
  with si do
  begin
    cb := sizeof(si);
    lpReserved := nil;
    lpDesktop := nil;
    lpTitle := PChar('External program "' + CmdLine + '"');
    dwFlags := 0;
    cbReserved2 := 0;
    lpReserved2 := nil;
  end;

  tick:=GetTickCount;

  SetCurrentDirectory(PChar(ExtractFilePath(Application.ExeName)+'pool\'));

  CreateProcessA(
        nil,
        PChar(CmdLine),
        nil,
        nil,
        LongBool(false),
        DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS,
        nil,
        nil,
        si,
        pi
        );

  Result.TimeoutFailed:=false;
  Result.RuntimeError:=false;

  while true do
  begin

     if getTickCount - tick > Timeout then
     begin
        Result.TimeoutFailed := true;
        TerminateProcess(pi.hProcess,0);
     end;

     if not WaitForDebugEvent(dbg, 20) then continue;

     ContinueDebugEvent(dbg.dwProcessId, dbg.dwThreadId, DBG_CONTINUE);

     if (dbg.dwDebugEventCode = EXCEPTION_DEBUG_EVENT) and
     (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_SINGLE_STEP) and
     (dbg.Exception.ExceptionRecord.ExceptionCode <> EXCEPTION_BREAKPOINT) then
     begin
        Result.RuntimeErrorCode := dbg.Exception.ExceptionRecord.ExceptionCode;
        Result.RuntimeError := true;
        TerminateProcess(pi.hProcess, 0);
     end;

     if dbg.dwDebugEventCode = EXIT_PROCESS_DEBUG_EVENT then
      break;
  end;

  eCode := 0;

 repeat
  WaitForDebugEvent(dbg, 5);
  ContinueDebugEvent(dbg.dwProcessId, dbg.dwThreadId, DBG_CONTINUE);

   GetExitCodePRocess(pi.hProcess, eCode);
  until eCode<>STILL_ACTIVE;

  Result.ReturnResult:=eCode;

  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
end;

Function Compile(CompilerCmdLine: String; Filename: string):TProgramResult;
var
  p: Integer;
begin
  p:=pos('%1', CompilerCmdLine);
  while p<>0 do
  begin
    Delete(CompilerCmdLine, p, 2);
    Insert(Filename, CompilerCmdLine, p);
    p:=pos('%1', CompilerCmdLine);
  end;
  Result:=RunProgram(CompilerCmdLine, 400000);
end;

const
  rGood = 'good';
  rNotCompiled = 'not compiled';
  rRuntime = 'runtime';
  rTimeout = 'timeout';

Function CompileAndRun(Filename: string): string;
var
  res: TProgramResult;
begin

  if Compile('dcc32 "%1.dpr"', Filename).ReturnResult<>0 then
  begin
    Result:=rNotCompiled;
    exit;
  end;

  res:=RunProgram(Filename+'.exe',4000);

  if res.TimeoutFailed then
  begin
    Result:=rTimeout;
    exit;
  end;

  if res.RuntimeError then
  begin
    Result:=rRuntime;
    exit;
  end;

  Result:= rGood;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption:=CompileAndRun('con_prog');

end;

end.

Rennigth

Дата 26.4.2007, 09:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

vertex_ua, Код не проверял, но есть подозрение что все-таки хендл процесса полученный после CreateProcess не имеет прав на TerminateProcess. Выдержка из MSDN:

Цитата

hProcess
[in] A handle to the process to be terminated.
The handle must have the PROCESS_TERMINATE access right. For more information, see Process Security and Access Rights.

--------------------

(* Honesta mors turpi vita potior *)

Rennigth

Дата 26.4.2007, 11:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

vertex_ua, Вообщем перед TerminateProcess надо отладку ведь останавливать smile

Вот этим к примеру DebugActiveProcessStop.

Вообщем примерно тякь:

Код


unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

function DebugSetProcessKillOnExit(bKillOnExit: LongBool): DWORD; stdcall; external 'Kernel32.dll';
function DebugActiveProcessStop(dwProcessId: DWORD): LongBool; stdcall; external 'Kernel32.dll';


implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  lExitCode: DWORD;
  hProcess: DWORD;
begin
  with si do
  begin
    cb := SizeOf(TStartupInfo);
    lpReserved := nil;
    lpDesktop := nil;
    lpTitle := PChar('Test Debug Run: "' + CmdLine + '"');
    dwFlags := 0;
    cbReserved2 := 0;
    lpReserved2 := nil;
  end;

  if not CreateProcess(nil, PChar('c:\WINDOWS\system32\mspaint.exe'), nil, nil,
    LongBool(False), DEBUG_PROCESS or DEBUG_ONLY_THIS_PROCESS, nil, nil, si, pi) then
    RaiseLastOSError(GetLastError);

  WaitForSingleObject(pi.hProcess, 2000);

  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);

  DebugActiveProcessStop(pi.dwProcessId);

  hProcess := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION, False, pi.dwProcessId);

  if hProcess = 0 then
    RaiseLastOSError(GetLastError);

  if not TerminateProcess(hProcess, lExitCode) then
  begin
    CloseHandle(hProcess);
    RaiseLastOSError(GetLastError);
  end;

  if not GetExitCodeProcess(hProcess, lExitCode) then
  begin
    CloseHandle(hProcess);
    RaiseLastOSError(GetLastError);
  end;

  if lExitCode = STILL_ACTIVE then
    MessageDlg('Process not Terminated', mtInformation, [mbOK], 0)
  else
    MessageDlg('Process Terminated: ExitCode', mtInformation, [mbOK], 0);

  CloseHandle(hProcess);
end;

end.

--------------------

(* Honesta mors turpi vita potior *)

W4FhLF

Дата 28.4.2007, 15:01 (ссылка)

(нет голосов)

Загрузка ...

found myself

Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121

Цитата(Rennigth @ 26.4.2007, 11:31

)

vertex_ua, Вообщем перед TerminateProcess надо отладку ведь останавливать Вот этим к примеру DebugActiveProcessStop.

Ну путай человека, он же Parent созданного процесса, зачем тут сдался DebugActiveProcessStop?

vertex_ua, чтобы закрыть процесс под отладкой надо уничтожить его хэндлы, а убить процесс, который находится под отладкой стандартными способами конечно нельзя:

CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);

Это сообщение отредактировал(а) W4FhLF - 28.4.2007, 15:04

--------------------

"Бог умер" © Ницше
"Ницше умер" © Бог

Rennigth

Дата 28.4.2007, 15:13 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

W4FhLF,
хм, у меня без

Код


  DebugActiveProcessStop

выполнив просто

Код


  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);

процесс не умирал.
А мой пример по сути аналогичен примеру автора. Может я в чем то не прав, но попробуй мой пример без DebugActiveProcessStop. Процесс так и останется жить пока не завершиться вызвавший его.

--------------------

(* Honesta mors turpi vita potior *)

W4FhLF

Дата 28.4.2007, 15:18 (ссылка)

(нет голосов)

Загрузка ...

found myself

Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121

Туплю, Rennigth, ты прав, теряю квалификаю блин smile

--------------------

Rennigth

Дата 28.4.2007, 15:19 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

Я просто этим вопросом до этого никогда не занимался, а на скорую руку все что нашел в мсдне так это DebugActiveProcessStop. Да и вроде как как было написано ее предназначение как раз в этом.
Могу ошибаться, пошел перечитывать smile

Добавлено через 1 минуту и 6 секунд
о гыгыг... уже не нужно...

--------------------

(* Honesta mors turpi vita potior *)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »