Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > Запуск defrag.exe под Windows XP 64


Автор: MadCoder 17.7.2009, 13:47
Добрый день!

Не могу запустить под Windows XP 64 дефрагментатор (defrag.exe), хотя под обычной Windows XP он запускается. Пишу на Delphi 2009.

Код следующий:
Код

...
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
  Text: TStringList;
  Text2: String;
  ExitCode: Cardinal;
//  Error: integer;
  Filename: String;
begin
  Text:=TStringList.Create;
  with Security do
    begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
    end;
  if Createpipe(ReadPipe, WritePipe,
    @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +
      STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_SHOW;
    Filename:='C:\Windows\System32\defrag.exe C: -a';
    if CreateProcess(nil,
      PWCHAR(WideString((Filename))),
      @Security,
      @Security,
      true,
      NORMAL_PRIORITY_CLASS,
      nil,
      nil,
      start,
      ProcessInfo) then
      ShowMessage('Запущено успешно!');
        
   else ShowMessage('Не удалось запустить');
...


Добавлено через 52 секунды
Пробую руками запустить через консоль (C:\Windows\System32\defrag.exe C: -a), отрабатывает нормально...

Автор: CodeMonkey 17.7.2009, 14:25
Код
  if not CreateProcess(...) then
    RaiseLastOSError;

Автор: MadCoder 17.7.2009, 14:32
---------------------------
Application Error
---------------------------
Exception EOSError in module defrag.bop at 000127AD.

---------------------------
OK   
---------------------------

Автор: CodeMonkey 17.7.2009, 14:43
А из под отладчика не судьба запустить?  smile
Или хотя бы try/except поставить, раз уж у вас не VCL-приложение:
Код
  try
    .... // create process
  except
    on E: Exception do
      MessageBox(0, PChar(E.Message), 'gg', MB_OK);
  end;


P.S.
Возможно, суть в этом: http://msdn.microsoft.com/en-us/library/aa365743(VS.85).aspx:
Цитата(http://msdn.microsoft.com/en-us/library/aa365743(VS.85).aspx)
The following example uses Wow64DisableWow64FsRedirection to disable file system redirection so that a 32-bit application that is running under WOW64 can open the 64-bit version of Notepad.exe in %SystemRoot%\System32 instead of being redirected to the 32-bit version in %SystemRoot%\SysWOW64.


Добавлено через 2 минуты и 57 секунд
http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1392.

Автор: MadCoder 17.7.2009, 15:59
Спасибо, Манки!

Действительно, дело было в Wow64DisableWow64FsRedirection, решил отключением перед выполнением функции и включением после.
Код функции включения\отключения следующий:
Код

function ChangeFSRedirection(bDisable: Boolean): Boolean; 
type 
     TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall; 
     TWow64EnableWow64FsRedirection  = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall; 
var 
    hHandle: THandle; 
    Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection; 
    Wow64EnableWow64FsRedirection:  TWow64EnableWow64FsRedirection; 
    Wow64FsEnableRedirection:       LongBool; 
begin 
  Result := false; 

  if not IsWindows64 then 
     Exit; 

  try 
    hHandle := GetModuleHandle('kernel32.dll'); 
    @Wow64EnableWow64FsRedirection  := GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection'); 
    @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection'); 

    if bDisable then 
    begin 
     if (hHandle <> 0) and (@Wow64DisableWow64FsRedirection <> nil) then 
     begin 
       Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection); 
       Result := True; 
     end; 
    end else 
    begin 
     if (hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) then 
     begin 
       Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection); 
       Result := True; 
     end; 
    end; 
  Except 
  end; 
end;


Функция IsWindows64 находится в библиотеке JCL (пакет JVCL).

Большое спасибо за помощь!

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)