Ошибка в функции, содержащей WinAPI (CreateProcess и др.)

← →
Unknown Mystic © (2004-08-31 16:05) [0]

Помогите, пожалуйста, написать функцию, чтобы можно было заменить выделенный фрагмент

// Данный фрагмент кода работает. procedure TMainForm.btnUpdateClick(Sender: PObj); var ... iExitCode: integer; sArch, sArchParam, sReceiveDir: string; TSI: TStartupInfo; TPI: TProcessInformation; cExitCode: Cardinal; Msg: TMSG; begin ... ///////////////////////////////////////////////////////////////// // Устанавливаем видимость окна в SW_HIDE if false then TSI.wShowWindow := SW_SHOWDEFAULT else TSI.wShowWindow := SW_HIDE; TSI.dwFlags := STARTF_USESHOWWINDOW; // Выполняем команду для распаковки CreateProcess(nil, PChar(sArch + " " + sArchParam), nil, nil, false, NORMAL_PRIORITY_CLASS, nil, PChar(sReceiveDir), TSI, TPI); // Ждем завершения выполнения While true do case MsgWaitForMultipleObjects(1, TPI.hProcess, false, INFINITE, QS_PAINT or QS_MOUSE) of WAIT_OBJECT_0: Break; WAIT_OBJECT_0 + 1 .. WAIT_OBJECT_0 + 2: while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; // Получаем код возврата GetExitCodeProcess(TPI.hProcess, cExitCode); iExitCode := cExitCode; ///////////////////////////////////////////////////////////////// ... end;

на что-то вроде
iExitCode := RunApp(sArch + " " + sArchParam, sReceiveDir, false); // false - окно не видимо
или наверно лучше на
iExitCode := RunApp(PChar(sArch + " " + sArchParam), PChar(sReceiveDir), false);

Если просто перенести этот код в функцию, то при запуске любой программы вылазит ошибка инициализации и она (программа) завершается. iExitCode равен 128...

Может я не верно с PChar обращаюсь? - больше идей нету.

Заранее благодарен.

← →
Digitman © (2004-08-31 16:19) [1]

TSI.cb := sizeof(TSI);

if false then TSI.wShowWindow := SW_SHOWDEFAULT
else TSI.wShowWindow := SW_HIDE;
TSI.dwFlags := STARTF_USESHOWWINDOW;

// Выполняем команду для распаковки
if CreateProcess(nil, PChar(sArch + " " + sArchParam), nil, nil, false, NORMAL_PRIORITY_CLASS,
nil, PChar(sReceiveDir), TSI, TPI) then
begin
// Ждем завершения выполнения
While true do
case MsgWaitForMultipleObjects(1, TPI.hProcess, false, INFINITE,
QS_PAINT or QS_MOUSE) of
WAIT_OBJECT_0: Break;
WAIT_OBJECT_0 + 1:
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
// Получаем код возврата
GetExitCodeProcess(TPI.hProcess, cExitCode);
CloseHandle(TPI.hThread);
CloseHandle(TPI.hProcess);
end;

← →
GrayFace © (2004-08-31 18:16) [2]

Digitman © (31.08.04 16:19) [1]
if false then TSI.wShowWindow := SW_SHOWDEFAULT
else TSI.wShowWindow := SW_HIDE
:)

← →
Digitman © (2004-09-01 09:08) [3]

> GrayFace © (31.08.04 18:16) [2]

я даже и не посмотрел на эту чушь, скопировал один-в-один, добавив совершенно необходимый код

← →
Unknown Mystic © (2004-09-01 10:29) [4]

>> Digitman © (31.08.04 16:19) [1]

Не помогло...
Если в самой функции делать преобразование string -> pchar, тогда вызов
iExitCode := RunApp(sArch + " " + sArchParam, sReceiveDir, false);
то ничего не изменилось (в смысле ошибок), а если сразу передавать pchar, т.е.
iExitCode := RunApp(PChar(sArch + " " + sArchParam), PChar(sReceiveDir), false);
то первый вызов функции проходит нормально, а дальше та же ошибка и выход.

>> GrayFace © (31.08.04 18:16) [2]

Это код функции, с минимальными изменениями.

← →
Digitman © (2004-09-01 10:52) [5]

приведи свой вариант объявления и реализации ф-ции RunApp()

← →
Unknown Mystic © (2004-09-01 13:06) [6]

Объявления нету - просто код в разделе implementation сразу после раздела var.
function RunApp(pCmdLine, pWorkDir: PChar; bShow: boolean): Integer; var TSI: TStartupInfo; TPI: TProcessInformation; cExitCode: Cardinal; Msg: TMSG; begin TSI.cb := sizeof(TSI); if bShow then TSI.wShowWindow := SW_SHOWDEFAULT else TSI.wShowWindow := SW_HIDE; TSI.dwFlags := STARTF_USESHOWWINDOW; CreateProcess(nil, pCmdLine, nil, nil, false, NORMAL_PRIORITY_CLASS, nil, pWorkDir, TSI, TPI); // Ждем завершения выполнения While true do case MsgWaitForMultipleObjects(1, TPI.hProcess, false, INFINITE, QS_PAINT or QS_MOUSE) of WAIT_OBJECT_0: Break; WAIT_OBJECT_0 + 1 .. WAIT_OBJECT_0 + 2: while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; // Получаем код возврата GetExitCodeProcess(TPI.hProcess, cExitCode); CloseHandle(TPI.hThread); CloseHandle(TPI.hProcess); Result := cExitCode; end;

← →
Digitman © (2004-09-01 13:13) [7]

опять двадцать пять ...

ну ты хоть в код-то в [1] вникал ?

CreateProcess - функция !! а не процедура ... почему не анализируешь результат ее выполнения ?

WAIT_OBJECT_0 + 2 - а это откуда здесь взялось ? у тебя всего один объект синхронизации ... максимум что можно ожидать - WAIT_OBJECT_0 + 1

← →
Unknown Mystic © (2004-09-01 13:58) [8]

>> Digitman © (01.09.04 13:13) [7]

Виноват :( Увидел выделенные фрагменты, а остальное не посмотрел...

CreateProcess - поправлю и посмотрю что он выдает...

Я думал, что
QS_PAINT - WAIT_OBJECT_0 + 1
QS_MOUSE - WAIT_OBJECT_0 + 2

И еще вопрос попутно возник:
Имеет ли значение последовательность выполнения?
CloseHandle(TPI.hThread); CloseHandle(TPI.hProcess);
А то в примере MSDNа наоборт.

← →
Digitman © (2004-09-01 14:08) [9]

> поправлю и посмотрю что он выдает

да... и это важно

> думал, что
> QS_PAINT - WAIT_OBJECT_0 + 1
> QS_MOUSE - WAIT_OBJECT_0 + 2

нет.

WAIT_OBJECT_0 - стартованный тобой процесс завершился
WAIT_OBJECT_0 + 1 - в очереди сообщений окна, созданного текущим трэдом, есть сообщения. которые необходимо обработать, что собственно ты и делаешь в цикле while PeekMessage() do..

> Имеет ли значение последовательность выполнения?
>
> CloseHandle(TPI.hThread);
> CloseHandle(TPI.hProcess);

думаю что в принципе не имеет , хэндлы так или иначе должны быть закрыты, коль они созданы системой в ходе вызова Createprocess() и возвращены тебе

← →
Unknown Mystic © (2004-09-01 14:21) [10]

Спасибо. К сожалению Delphi есть только дома. Завтра скажу, что получилось.

А такой вызов функции верен? (Я в преобразовании сомневаюсь.)
iExitCode := RunApp(PChar(sArch + " " + sArchParam), PChar(sReceiveDir), false);

← →
Digitman © (2004-09-01 14:28) [11]

> Unknown Mystic © (01.09.04 14:21) [10]

> А такой вызов функции верен?

при приведенной тобой конкретной декларации ф-ции RunApp() почему же не верен ? я не вижу тут никаких подводных камней ..

> в преобразовании сомневаюсь

поделился бы сомнениями, коль имеются ..

← →
GrayFace © (2004-09-01 17:44) [12]

Зачем нужен cExitCode? Просто подавай Cardinal(Result).

Поправил. CreateProcess() false возващает и программа вылетает.

Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

// Прошу прощения за такой перерыв...

На текущий момент функция:

function RunApp(pCmdLine, pWorkDir: PChar; bShow: boolean): Integer; var TSI: TStartupInfo; TPI: TProcessInformation; cExitCode: Cardinal; Msg: TMSG; RunOK: string; dw: DWord; lpMsgBuf: string; begin MainForm.reLog.Add(#13#10 + pCmdLine + #13#10); MainForm.reLog.Add(pWorkDir + #13#10); Result := -1; TSI.cb := SizeOf(TSI); if bShow then TSI.wShowWindow := SW_SHOWDEFAULT else TSI.wShowWindow := SW_HIDE; TSI.dwFlags := STARTF_USESHOWWINDOW; RunOK := "CreateProcess return false"; if CreateProcess(nil, pCmdLine, nil, nil, false, NORMAL_PRIORITY_CLASS, nil, pWorkDir, TSI, TPI) then begin RunOK := "CreateProcess return true"; // Ждем завершения выполнения While true do case MsgWaitForMultipleObjects(1, TPI.hProcess, false, INFINITE, QS_PAINT or QS_MOUSE) of WAIT_OBJECT_0: Break; WAIT_OBJECT_0 + 1: while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; // Получаем код возврата GetExitCodeProcess(TPI.hProcess, Cardinal(Result)); CloseHandle(TPI.hThread); CloseHandle(TPI.hProcess); end else begin dw := GetLastError(); MainForm.reLog.Add("Error " + Int2Str(dw) + " - "+ SysErrorMessage(dw) + #13#10); { FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER OR FORMAT_MESSAGE_FROM_SYSTEM, nil, dw, LANG_RUSSIAN,//MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), PChar(lpMsgBuf), 0, nil ); MainForm.reLog.Add("CreateProcess() failed with error " + Int2Str(dw) + ": " + lpMsgBuf + #13#10);} end; MainForm.reLog.Add(RunOK + #13#10 + #13#10); end;

вызывается:

iExitCode := RunApp(PChar(sArch + " " + sArchParam), PChar(sReceiveDir), false);

В результате выполнения в MainForm.reLog попадает строкаи (кроме верных pCmdLine и pWorkDir):
Error 998 - Не верная попытка доступа к адресу памяти.
CreateProcess return false

После чего вылазит сообщение об ошибке:
Инструкция по адресу "0x77f8c15c" обратилась к памяти по адресу 0x00000003.
Память не может быть "read".

// С что-то не вышло поэтому и закомментировал.

для начала почисть структуру TSI

FillChar(TSI, SizeOf(TSI), 0);
TSI.cb := SizeOf(TSI);

Почистил и все заработало. Уже на 3-ем ПК все нормально работает. Большое спасибо!

Может есть еще замечания по поводу моего кода?

Ошибка в функции, содержащей WinAPI (CreateProcess и др.) Найти похожие ветки