implementation {$R *.dfm} function WinExecAndWait32(FileName: string; Visibility: Integer; var mOutputs: string): Cardinal; var sa: TSecurityAttributes; hReadPipe, hWritePipe: THandle; ret: BOOL; strBuff: array[0..255] of char; lngBytesread: DWORD; WorkDir: string; StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; begin FillChar(sa, Sizeof(sa), #0); sa.nLength := Sizeof(sa); sa.bInheritHandle := True; sa.lpSecurityDescriptor := nil; ret := CreatePipe(hReadPipe, hWritePipe, @sa, 0); WorkDir := ExtractFileDir(Application.ExeName); FillChar(StartupInfo, Sizeof(StartupInfo), #0); StartupInfo.cb := Sizeof(StartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; StartupInfo.wShowWindow := Visibility; StartupInfo.hStdOutput := hWritePipe; StartupInfo.hStdError := hWritePipe; if not CreateProcess(nil, PChar(FileName), { pointer to command line string } @sa, { pointer to process security attributes } @sa, { pointer to thread security attributes } True, { handle inheritance flag } // CREATE_NEW_CONSOLE or { creation flags } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } PChar(WorkDir), { pointer to current directory name, PChar} StartupInfo, { pointer to STARTUPINFO } ProcessInfo) { pointer to PROCESS_INF } then Result := INFINITE {-1} else begin // Form1.Hide; // FileOpen(FileName,fmShareExclusive); // SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); ret := CloseHandle(hWritePipe); mOutputs := ''; while ret do begin FillChar(strBuff, Sizeof(strBuff), #0); ret := ReadFile(hReadPipe, strBuff, 256, lngBytesread, nil); mOutputs := mOutputs + strBuff; end; Application.ProcessMessages; WaitforSingleObject(ProcessInfo.hProcess, INFINITE); GetExitCodeProcess(ProcessInfo.hProcess, Result); CloseHandle(ProcessInfo.hProcess); { to prevent memory leaks } CloseHandle(ProcessInfo.hThread); // Form1.Close; { exit application } ret := CloseHandle(hReadPipe); end; end; procedure TForm1.Button1Click(Sender: TObject); var Val: Cardinal; mOutputs: string; i: integer; begin if UpperCase(edt1.Text) = 'CLS' then begin mmo1.Clear; edt1.Text := ''; end else begin Button1.enabled := false; Val := WinExecAndWait32('cmd /c' + ' ' + '"' + edt1.text + '"', SW_hide, mOutputs); i := 1; while i <= length(mOutputs) do begin if mOutputs[i] = #10 then begin Insert(#13, mOutputs, i); i := i + 2; end else Inc(i); end; end; Mmo1.Lines.Add(mOutputs); edt1.Text := ''; Button1.enabled := True; end; procedure TForm1.mmo1KeyPress(Sender: TObject; var Key: Char); var Val: Cardinal; mOutputs: string; i: integer; begin if Key = #13 then begin if UpperCase(edt1.Text) = 'CLS' then begin mmo1.Clear; edt1.Text := ''; end else begin Button1.enabled := false; Val := WinExecAndWait32('cmd /c' + ' ' + '"' + edt1.text + '"', SW_hide, mOutputs); i := 1; while i <= length(mOutputs) do begin if mOutputs[i] = #10 then begin Insert(#13, mOutputs, i); i := i + 2; end else Inc(i); end; end; Mmo1.Lines.Add(mOutputs); edt1.Text := ''; Button1.enabled := true; end; end; procedure TForm1.btn1Click(Sender: TObject); begin if dlgOpen1.Execute then edt1.Text := dlgOpen1.FileName; end; end.
