如何将ShellExecute Api函数打开MS_DOS窗口后, 自动关闭?

Question

送你一个重订向DOS输出的函数
EXAM:Memo.Lines.Text := GetDOSResult(Edit1.Text, ExitCode);//==============================================================================
//运行DOS程序并返回它的输出*****************************************************
//==============================================================================
function GetDOSResult(const CommandLine: string; var ExitCode:DWORD): string;
  procedure CheckResult(Bool: Boolean);
  begin
    if not Bool then raise Exception.Create(SysErrorMessage(GetLastError));
  end;
var HRead, HWrite: THandle;
    StartInfo: TStartupInfo;
    ProceInfo: TProcessInformation;
    SecuAttr: TSecurityAttributes;
    inS: THandleStream;
    WriteStream: TStrings;
    fSuccess: Boolean;
begin
  Result := '';
  FillChar(SecuAttr,sizeof(SecuAttr),0);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  //设置允许继承,否则在NT和2000下无法取得输出结果*******************************
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  SecuAttr.nLength := SizeOf(SecuAttr);
  SecuAttr.bInheritHandle := true;
  SecuAttr.lpSecurityDescriptor := nil;
  fSuccess := CreatePipe(HRead,HWrite,@SecuAttr,0);
  CheckResult(fSuccess);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  FillChar(StartInfo,SizeOf(StartInfo),0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_HIDE;
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  StartInfo.dwFlags     := STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
  StartInfo.hStdError   := HWrite;
  StartInfo.hStdInput   := GetStdHandle(STD_INPUT_HANDLE);//HRead;
  StartInfo.hStdOutput  := HWrite;
  fSuccess := CreateProcess(nil,PChar(CommandLine),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,StartInfo,ProceInfo);
  CheckResult(fSuccess);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  WaitForSingleObject(ProceInfo.hProcess,INFINITE);
  GetExitCodeProcess(ProceInfo.hProcess,ExitCode);
  inS := THandleStream.Create(HRead);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if inS.Size>0 then
  begin
    WriteStream := TStringList.Create;
    WriteStream.LoadFromStream(inS);
    Result := WriteStream.Text;
    WriteStream.Free;
  end;
  inS.Free;
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  CloseHandle(HRead);
  CloseHandle(HWrite);
end;

Answer 1

简单的方法是调用ShellExecuteEx，从它的返回结构ShellExecuteInfo中，可以得到Process Handle。

Answer 2

function ExecuteFile(hWnd: HWND; Operation, FileName, Parameters,
   Directory: PChar; ShowCmd: Integer): THandle;
var
  ExtInfo: ShellExecuteInfo;
  PExtInfo: PSHELLEXECUTEINFO;
  I: integer;
begin
  ExtInfo.cbSize := SIZEOF(ExtInfo);
  ExtInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_DOENVSUBST or SEE_MASK_CONNECTNETDRV;
  ExtInfo.Wnd := hWnd;
  ExtInfo.lpVerb := Operation;
  ExtInfo.lpFile := FileName;
  ExtInfo.lpParameters := Parameters;
  ExtInfo.lpDirectory := Directory;
  ExtInfo.nShow := ShowCmd;
  PExtInfo := @ExtInfo;
  Result := ShellExecuteEx(PExtInfo);
  I := Length(ExeFileList);
  SetLength(ExeFileList, I+1);
  Result := ExtInfo.hProcess;
end;...
 CloseHandle(..)

Answer 3

uses tlhelp32;//==============================================================================
//强制终止某应用程序运行********************************************************
//==============================================================================
procedure AppForceExit(const AppName: string);
var lppe: TProcessEntry32;
    ssHandle: THandle;
    Wnd: HWND;
    AppFound: Boolean;
begin
  ssHandle := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  AppFound := Process32First(sshandle, lppe);
  while AppFound do
  begin
    //其中lppe.szExefile就是程序名**********************************************
    if UpperCase(ExtractFileName(lppe.szExeFile))=UpperCase(AppName) then
    begin
      Wnd := OpenProcess(PROCESS_ALL_ACCESS, true, lppe.th32ProcessID);
      TerminateProcess(Wnd, 0);
    end;
    AppFound := Process32Next(ssHandle, lppe);
  end;
end;procedure TForm_Main.Button1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'Open', PChar('ping.exe'), PChar('192.168.1.11 -t'), nil, SW_SHOWNORMAL);
end;procedure TForm_Main.Button2Click(Sender: TObject);
begin
  AppForceExit('ping.exe');
end;

Answer 4

我在WinMe+D6下测了一下，没问题