[zxen]

Нарыл и приспособил немножко другой код.. Есть небольшая проблемка, когда программа запускает например пинг. ехе, во время обработки пргрпмму невозжожно закрыть крестиком, вставил паузу (стр. 116) программа не виснет , но крестик все равно не нажимается. И как можно закрывать порограммы, запущенные CreateProcess'om.. тасккил по имени как то тупо.. И еще, как бы сделать так, чтоб текст вывода консоли добавлялся к уже существующему в мемо, а не стирался с каждым новым выводом. Memo1.Text:= Memo1.Text + DosToWin(getcmdval) не работает, выполняется первая команда, дальше вообще ничего в мемо не пишется.

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166

unit Unit1;   interface   uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, Winapi.ShellAPI;   type   TForm1 = class(TForm)     Button1: TButton;     Memo1: TMemo;     Edit1: TEdit;     Button2: TButton;     Button3: TButton;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);     procedure Edit1KeyPress(Sender: TObject; var Key: Char);     private        function GetDosOutput(const CommandLine:string): string;   public       end;   var   Form1: TForm1;     implementation   {$R *.dfm}   var stopfunc: Integer;   function DosToWin(ASource: AnsiString): AnsiString;  var    Ch: PAnsiChar;  begin    Ch := AnsiStrAlloc(Length(ASource) + 1);    OemToAnsi(PAnsiChar(ASource), Ch);    Result := StrPas(Ch);    StrDispose(Ch);  end;     function TForm1.GetDosOutput(const CommandLine:string): string; var   SA: TSecurityAttributes;   SI: TStartupInfoA;   PI: TProcessInformation;   StdOutPipeRead, StdOutPipeWrite: THandle;   WasOK: Boolean;   Buffer: array[0..255] of AnsiChar;   BytesRead: Cardinal;   WorkDir, Line: String;   i:Integer; begin stopfunc:=0;   Application.ProcessMessages;   with SA do   begin     nLength := SizeOf(SA);     bInheritHandle := True;     lpSecurityDescriptor := nil;   end;     CreatePipe(StdOutPipeRead,              StdOutPipeWrite,              @SA,              0              );   try       with SI do     begin       FillChar(SI, SizeOf(SI), 0);       cb := SizeOf(SI);       dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;       wShowWindow := SW_HIDE;       hStdInput := GetStdHandle(STD_INPUT_HANDLE);       hStdOutput := StdOutPipeWrite;       hStdError := StdOutPipeWrite;     end;       WorkDir := ExtractFilePath(CommandLine);           WasOK:=CreateProcessa(nil, PAnsiChar(AnsiString(CommandLine)), nil, nil, True, 0, nil, PAnsiChar('C:\WINDOWS\system32\'), SI, PI);     //WasOK := CreateProcess(nil, PChar('C:\WINDOWS\system32\cmd.exe'), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);       CloseHandle(StdOutPipeWrite);       if not WasOK then       raise Exception.Create('Could not execute command line!')     else       try           Line := '';         repeat             WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);           if BytesRead > 0 then             begin               Buffer[BytesRead] := #0;             Line := Line + Buffer;             if (Copy(Form1.Edit1.text,1,4) = 'ping') then begin                Form1.Memo1.text := DosToWin(Line); // конвертим вывод в мемо, с ОЕМ в Анси               Memo1.Perform(EM_LINESCROLL,0,Memo1.Lines.Count-1); // автопрокрутка мемо вниз                //////////////////////////  пауза, чтоб не висло окно при пинге и множественных выводов консоли                 i := 0;                while i<100 do begin               sleep(12);               Application.ProcessMessages;               inc(i);               end;                 //// убиваем процессы               if stopfunc = 1 then                begin                CloseHandle(PI.hThread);                CloseHandle(PI.hProcess);                shellexecute(0,'Open',Pchar('taskkill'),'/im cmd.exe /f',0,SW_HIDE);                shellexecute(0,'Open',Pchar('taskkill'),'/im ping.exe /f',0,SW_HIDE);               Exit;              end;             end;               end;         until not WasOK or (BytesRead = 0);         WaitForSingleObject(PI.hProcess, INFINITE);       finally         CloseHandle(PI.hThread);         CloseHandle(PI.hProcess);       end;   finally       result:=Line;       CloseHandle(StdOutPipeRead);   end; end;   //// выполняем команду CMD procedure TForm1.Button1Click(Sender: TObject);  var cmdinput, getcmdval, memotxt: string;   begin      Edit1.Text:= Trim(Edit1.Text); // удаляем пробелы в начале и в конце в строке ввода    cmdinput:= 'cmd.exe /c ' + Edit1.Text; // текст посылаемый в функцию       memotxt:= Memo1.Text;     getcmdval:= GetDosOutput(cmdinput);         Memo1.Text:=  DosToWin(getcmdval); end;       /// останавливаем выполнение CMD procedure TForm1.Button2Click(Sender: TObject); begin stopfunc:=1; end;   end.