Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Unknown Mystic ©   (2004-08-31 16:05:00) 

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


// Данный фрагмент кода работает.
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 обращаюсь? - больше идей нету.

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

Unknown Mystic   (2004-09-23 12:03:00) [1]

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

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

Digitman   (2004-09-22 09:30:00) [2]

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

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

Unknown Mystic   (2004-09-20 13:19:00) [3]

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

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

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".

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

Digitman   (2004-09-02 12:24:00) [4]

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.

Unknown Mystic   (2004-09-02 12:21:00) [5]

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

GrayFace   (2004-09-01 17:44:00) [6]

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

Digitman   (2004-09-01 14:28:00) [7]


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


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


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


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


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

Unknown Mystic   (2004-09-01 14:21:00) [8]

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

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

Digitman   (2004-09-01 14:08:00) [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 13:58:00) [10]

>> 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 13:13:00) [11]

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

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

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

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

Unknown Mystic   (2004-09-01 13:06:00) [12]

Объявления нету - просто код в разделе 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 10:52:00) [13]

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

Unknown Mystic   (2004-09-01 10:29:00) [14]

>> 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 09:08:00) [15]


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


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

GrayFace   (2004-08-31 18:16:00) [16]

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

Digitman   (2004-08-31 16:19:00) [17]

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;

Наверх

Титульная страница Поиск, карта сайта Написать письмо