Помогите оптимизировать код (выполнения в консоли)!

← →
Pavel (2008-11-29 14:49) [0]

Пытался сделать свою программу для её использования вместо bat-файла. Всё работает, но каждый раз приходится запускать цикл:
procedure TForm1.Button1Click(Sender: TObject); var P:TProcessProcParam; begin P.ApplicationName := nil; P.CommandLine := "cmd.exe"; P.DataProc := AddToFormMemo; GoProcess(P); end;
И как (при необходимости) выполнить последовательность команд, чтобы они не выполнялись все сразу?!
Код такой:
type TProcessProcParam = record ApplicationName: PChar; CommandLine: PChar; DataProc: procedure (Str:PChar); end; PProcessProcParam = ^TProcessProcParam; function ProcessProc(P:PProcessProcParam):DWord; stdcall; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; SecurityAttributes: TSecurityAttributes; StdOutPipeRead, StdOutPipeWrite: THandle; CreateResult: Boolean; Chars: PChar; BytesReadFromFile: Cardinal; BytesReadFromPipe: Cardinal; WaitResult: Cardinal; begin with SecurityAttributes do begin nLength := SizeOf(SecurityAttributes); bInheritHandle := True; lpSecurityDescriptor := nil; end; CreateResult := CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SecurityAttributes, 0); if not CreateResult then begin P^.DataProc(nil); if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName); if assigned(P^.CommandLine) then FreeMem(P^.CommandLine); Dispose(P); Result := 1; Exit; end; with StartupInfo do begin FillChar(StartupInfo, SizeOf(StartupInfo), 0); cb := SizeOf(StartupInfo); dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; wShowWindow := SW_HIDE; hStdInput := 0;//StdOutPipeRead2;//GetStdHandle(STD_INPUT_HANDLE); hStdOutput := StdOutPipeWrite; hStdError := StdOutPipeWrite; end; ZeroMemory(@ProcessInfo, SizeOf(@ProcessInfo)); CreateResult := CreateProcess(P^.ApplicationName, P^.CommandLine, nil, nil, True, 0, nil, nil, StartupInfo, ProcessInfo); if not CreateResult then begin P^.DataProc(nil); CloseHandle(StdOutPipeRead); CloseHandle(StdOutPipeWrite); if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName); if assigned(P^.CommandLine) then FreeMem(P^.CommandLine); Dispose(P); Result := 2; Exit; end; repeat WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100); PeekNamedPipe(StdOutPipeRead, nil, 0, nil, @BytesReadFromPipe, nil); if BytesReadFromPipe > 0 then begin getMem(Chars, BytesReadFromPipe + 2); ZeroMemory(Chars, BytesReadFromPipe + 2); ReadFile(StdOutPipeRead, Chars^, BytesReadFromPipe, BytesReadFromFile, nil); OemToAnsi(Chars, Chars); P^.DataProc(Chars); FreeMem(Chars); end; until (WaitResult <> WAIT_TIMEOUT) and (BytesReadFromPipe = 0); P^.DataProc(nil); CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); CloseHandle(StdOutPipeRead); CloseHandle(StdOutPipeWrite); if assigned(P^.ApplicationName) then FreeMem(P^.ApplicationName); if assigned(P^.CommandLine) then FreeMem(P^.CommandLine); Dispose(P); Result := 0; end; procedure GoProcess(P:TProcessProcParam); var PP:PProcessProcParam; C:DWord; begin New(PP); if assigned(P.ApplicationName) then begin GetMem(PP^.ApplicationName, Length(P.ApplicationName)); StrCopy(PP^.ApplicationName, P.ApplicationName); end else begin PP^.ApplicationName := nil; end; if assigned(P.CommandLine) then begin GetMem(PP^.CommandLine, Length(P.CommandLine)); StrCopy(PP^.CommandLine, P.CommandLine); end else begin PP^.CommandLine := nil; end; PP^.DataProc := P.DataProc; CreateThread(nil, 0, @ProcessProc, PP, 0, C); end; procedure AddToFormMemo(Str:PChar); begin if assigned(Str) then Form1.Memo1.Lines.Add(Str) else Form1.Memo1.Lines.Add("выполнено"); end;

← →
Leonid Troyanovsky © (2008-11-29 15:16) [1]

> Pavel (29.11.08 14:49)

> Пытался сделать свою программу для её использования вместо
> bat-файла.

Вот отсюда - по-медленней.
Огласи все ТЗ.

--
Regards, LVT.

← →
Slym © (2008-11-29 15:51) [2]

Pavel (29.11.08 14:49)
1. какое обилие Диспозов/Фримемов Нюсов и гетмемов... не запутался?
2. DataProc вызывается в другом потоке и Form1.Memo1.Lines.Add(Str) вызовет ерор..
3. Пайпа нужно два... без hStdInput никуда...
4. ReadFile - не процедура, а функция возвращающая колво прочитанного
5. getMem(Chars, BytesReadFromPipe + 2); - что за магическая двойка?
6. И вообще код в топку...
7. Leonid Troyanovsky © (29.11.08 15:16) [1] +1

← →
Slym © (2008-11-29 15:52) [3]

не Ц++ случаем портируешь?

← →
Pavel (2008-11-29 16:03) [4]

> Leonid Troyanovsky © (29.11.08 15:16) [1]
Требуется следующее:
Получить в TMemo результат выполнения в консоли (динамично по мере выполнения), само консольное окно скрыть (дабы не мешало). Пытался сделать, чтобы выполнялось в отдельном потоке, но с возможностью как последовательного выполнения команд, так и нескольких сразу.

← →
Leonid Troyanovsky © (2008-11-29 16:25) [5]

> Pavel (29.11.08 16:03) [4]

> Получить в TMemo результат выполнения в консоли (динамично
> по мере выполнения), само консольное окно скрыть (дабы не
> мешало).

Ну, получить - не проблема.
А для передачи строки уже пущенному cmd нужно как-то извращаться:
может быть путем WriteConsoleInput в собс-ручно распределенную
консоль (AllocConsole) или путем PostMessage WM_CHAR
каждого символа строки (& #13) окну консоли.

Проще уж cmd /c command, выполнять по-одной.

--
Regards, LVT.

← →
Leonid Troyanovsky © (2008-11-29 16:33) [6]

> Pavel (29.11.08 16:03) [4]

> мешало). Пытался сделать, чтобы выполнялось в отдельном
> потоке, но с возможностью как последовательного выполнения
> команд, так и нескольких сразу.

А еще проще - пустить telnet service и написать к нему гуи-клиента,
если уж готовые не угодили.

--
Regards, LVT.

← →
Andy BitOff © (2008-11-29 16:48) [7]

А еще проще посмотреть форум поглубже. Недавно этот вопрос был решен положительно.

← →
Leonid Troyanovsky © (2008-11-29 16:51) [8]

> Andy BitOff © (29.11.08 16:48) [7]

> был решен положительно.

Подкинь, плиз, кейвордов, что-то я это пропустил.

--
Regards, LVT.

← →
Andy BitOff © (2008-11-29 16:54) [9]

> Leonid Troyanovsky © (29.11.08 16:51) [8]

http://delphimaster.net/view/2-1226165105/

Непосредственно ответ:
easy © (08.11.08 20:50) [2]
http://dfc.com.ru/?sid=2&id=7&itemid=2

← →
Slym © (2008-11-29 16:56) [10]

анализируй
uses windows,SysUtils,classes; type TOnStdOut=procedure(Sender:TObject;const Str:string) of object; TConsoleThread=class(TThread) private FCMD:string; FCloseHandles:boolean; FStdIn:TStrings; StdOutStr:string; FOnStdOut:TOnStdOut; FExitCode:DWord; protected procedure Execute;override; procedure DoStdOut; public constructor Create(const CMD:string;Commands:TStrings;CloseHandles:boolean=false);reintroduce; destructor Destroy; override; property ExitCode:DWord read FExitCode; property OnStdOut:TOnStdOut read FOnStdOut write FOnStdOut; end; constructor TConsoleThread.Create(const CMD:string;Commands:TStrings;CloseHandles:boolean=false); var i:integer; begin FCMD:=CMD; FCloseHandles:=CloseHandles; FStdIn:=TStringList.Create; if assigned(Commands) then begin FStdIn.BeginUpdate; try for I:= 0 to Commands.Count - 1 do FStdIn.AddObject(Commands[I]+#13#10, Commands.Objects[I]); finally FStdIn.EndUpdate; end; end; inherited Create(false); end; destructor TConsoleThread.Destroy; begin FStdIn.Free; inherited; end; procedure TConsoleThread.DoStdOut; begin if assigned(FOnStdOut) then FOnStdOut(self,StdOutStr); end; procedure TConsoleThread.Execute; var sa:TSecurityAttributes; si:TStartupInfo; pi:TProcessInformation; ChildStdInWr,ChildStdoutRd:THandle; ChildStdoutWr,ChildStdInRd:THandle; Tmp1,Tmp2:THandle; bytesRead:DWORD; p:PChar; begin ChildStdInWr:=0;ChildStdoutRd:=0; ChildStdoutWr:=0;ChildStdInRd:=0; Tmp1:=0;Tmp2:=0; sa.nLength:=sizeof(TSecurityAttributes); sa.bInheritHandle:=true; sa.lpSecurityDescriptor:=nil; try if not CreatePipe(ChildStdoutRd,ChildStdoutWr,@sa,0) then RaiseLastOSError; if not CreatePipe(ChildStdinRd,ChildStdinWr,@sa,0) then RaiseLastOSError; if not DuplicateHandle(GetCurrentProcess(),ChildStdoutRd,GetCurrentProcess(),@Tmp1,0,Fa lse,DUPLICATE_SAME_ACCESS) then RaiseLastOSError; if not DuplicateHandle(GetCurrentProcess(),ChildStdinWr,GetCurrentProcess(),@Tmp2,0,Fal se,DUPLICATE_SAME_ACCESS) then RaiseLastOSError; if ChildStdoutRd<>0 then if CloseHandle(ChildStdoutRd) then ChildStdoutRd:=0; if ChildStdinWr<>0 then if CloseHandle(ChildStdinWr) then ChildStdinWr:=0; ChildStdoutRd:=Tmp1;Tmp1:=0; ChildStdinWr:=Tmp2;Tmp2:=0; GetStartupInfo(si); si.cb:=sizeof(TStartupInfo); si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; si.hStdInput:=ChildStdInRd; si.hStdOutput:=ChildStdOutWr; si.hStdError:=ChildStdOutWr; si.wShowWindow:=SW_HIDE; if not CreateProcess(nil,PChar(FCMD),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then RaiseLastOSError; while not Terminated do begin if WaitForSingleObject(pi.hProcess,0)=WAIT_OBJECT_0 then begin GetExitCodeProcess(pi.hProcess,FExitCode); CloseHandle(pi.hProcess); CloseHandle(pi.hThread); Terminate; end; PeekNamedPipe(ChildStdoutRd,nil,0,nil,@bytesRead,nil); if bytesRead>0 then begin SetLength(StdOutStr,bytesRead); if not ReadFile(ChildStdoutRd,PChar(StdOutStr)^,bytesRead,bytesRead,nil) then RaiseLastOSError; SetLength(StdOutStr,bytesRead); OemToChar(PChar(StdOutStr),PChar(StdOutStr)); Synchronize(DoStdOut); end; while FStdIn.Count>0 do begin p:=PChar(FStdIn[0]); CharToOem(p,p); if not WriteFile(ChildStdinWr,p^,Length(FStdIn[0]),bytesRead,nil) then RaiseLastOSError; FStdIn.Delete(0); end; if FCloseHandles and (ChildStdinWr<>0) then if CloseHandle(ChildStdinWr) then ChildStdinWr:=0; end; finally if ChildStdoutRd<>0 then CloseHandle(ChildStdoutRd); if ChildStdoutWr<>0 then CloseHandle(ChildStdoutWr); if ChildStdinRd<>0 then CloseHandle(ChildStdinRd); if ChildStdinWr<>0 then CloseHandle(ChildStdinWr); if Tmp1<>0 then CloseHandle(Tmp1); if Tmp2<>0 then CloseHandle(Tmp2); end; end; end.

← →
Leonid Troyanovsky © (2008-11-29 17:09) [11]

> Andy BitOff © (29.11.08 16:54) [9]

> http://dfc.com.ru/?sid=2&id=7&itemid=2

А.. Это я, оказывается, видел.
Подобных функций я и сам в свое время понаписал.

Однако, тема передачи процессору (или, скажем, route)
строк для исполнения там не раскрыта.

Но, все равно, спасибо.

--
Regards, LVT.

← →
Slym © (2008-11-29 17:17) [12]

Leonid Troyanovsky © (29.11.08 17:09) [11]
как не раскрыта? А [10]?
там даже РАР с командой @ можно выполнить (ввод сжимаемых файлов с консоли)

← →
Leonid Troyanovsky © (2008-11-29 17:20) [13]

> Slym © (29.11.08 17:17) [12]

> как не раскрыта? А [10]?

Здесь вам не тут, а там вам покажут ;)

А [10] я еще не изучил.

--
Regards, LVT.

← →
Pavel (2008-11-29 17:36) [14]

> Slym © (29.11.08 16:56) [10]
> анализируй
> uses windows,SysUtils,classes;
> type
> TOnStdOut=procedure(Sender:TObject;const Str:string) of
> object;
> TConsoleThread=class(TThread)
> private
........

чтобы соображалось получше, можно, пожалуйста, пример использования?

← →
Slym © (2008-11-29 17:44) [15]

procedure TForm1.OnStdOut(Sender:TObject;const Str:string);
begin
Memo1.lines.add(Str);
end;

Source:=TstringList.Create;
Source.add("file1.txt");
Source.add("file2.exe");

//TConsoleThread - нужно доработать чтоб Suspend был
ConsoleThread:=TConsoleThread.Create("rar.exe a dest.rar @",Source,true);
ConsoleThread.OnStdOut:=OnStdOut;
ConsoleThread.Resume;
ConsoleThread.WaitFor;
ConsoleThread.free;

> Leonid Troyanovsky © (29.11.08 17:20) [13]

> А [10] я еще не изучил.

Изучаю.

1. Исключения в потоке без except.
2. FStdIn.BeginUpdate &etc - лишнее.
3. Некрасивый вывод из консоли - нет обработки #13 - #13#10.

Ну, и несмотря на FStdIn.AddObject(Commands)
нет передачи строки работающему экземпляру процессора.

Не знаю, может я чего-то непонятно говорю.

--
Regards, LVT.

аналогично copy con file.txt
Source:=TstringList.Create;
Source.add("file1.txt");
Source.add("file2.exe");
TConsoleThread.Create("cmd.exe. /c copy con file.txt",Source,true);

можно уйти от заранее сформированного Source... и слать напрямую...
procedure TConsoleThread.Write(const Str: string); begin CriticalSection.Enter; try FStdIn.Add(Str); finally CriticalSection.Leave; end; end;
procedure TConsoleThread.Execute; ..... while FStdIn.Count>0 do begin CriticalSection.Enter; try p:=PChar(FStdIn[0]); CharToOem(p,p); if not WriteFile(ChildStdinWr,p^,Length(FStdIn[0]),bytesRead,nil) then RaiseLastOSError; FStdIn.Delete(0); finally CriticalSection.Leave; end; end;
но загвостка в EOF!
она реализована так:
if FCloseHandles and (ChildStdinWr<>0) then if CloseHandle(ChildStdinWr) then ChildStdinWr:=0;
и в коде выше EOF был известен заранее... а тут придется придумывать...
CloseWrite

Leonid Troyanovsky © (29.11.08 17:51) [16]
Некрасивый вывод из консоли - нет обработки #13 - #13#10.
на коленке переписывается старый код...
а красоту сами наводите :)

Slym © (29.11.08 17:53) [17]
можно уйти от заранее сформированного Source... и слать напрямую...
procedure TConsoleThread.Write(const Str: string);
begin
CriticalSection.Enter;
try
FStdIn.Add(Str);
finally
CriticalSection.Leave;
end;
end;

или даже непосредственно в пайп
procedure TConsoleThread.Write(const Str: string); begin CharToOem(pchar(str),pchar(str)); if not WriteFile(ChildStdinWr,pchar(str)^,Length(Str),bytesRead,nil) then RaiseLastOSError; end;

unit Unit2; interface uses windows,SysUtils,classes; type TOnStdOut=procedure(Sender:TObject;const Str:string) of object; TConsoleThread=class(TThread) private FCMD:string; StdOutStr:string; FOnStdOut:TOnStdOut; FExitCode:DWord; StdInPipeR,StdInPipeW:THandle; StdOutPipeR,StdOutPipeW:THandle; protected procedure Execute;override; procedure DoStdOut; public constructor Create(const CMD:string;CreateSuspended: Boolean);reintroduce; destructor Destroy; override; procedure WriteToStdIn(const Str:string); property ExitCode:DWord read FExitCode; property OnStdOut:TOnStdOut read FOnStdOut write FOnStdOut; end; implementation constructor TConsoleThread.Create(const CMD:string;CreateSuspended: Boolean); var sa:TSecurityAttributes; begin FCMD:=CMD; sa.nLength:=sizeof(TSecurityAttributes); sa.bInheritHandle:=true; sa.lpSecurityDescriptor:=nil; Win32Check(CreatePipe(StdInPipeR,StdInPipeW,@sa,0)); Win32Check(CreatePipe(StdOutPipeR,StdOutPipeW,@sa,0)); inherited Create(CreateSuspended); end; destructor TConsoleThread.Destroy; begin if StdInPipeR<>0 then CloseHandle(StdInPipeR); if StdInPipeW<>0 then CloseHandle(StdInPipeW); if StdOutPipeR<>0 then CloseHandle(StdOutPipeR); if StdOutPipeW<>0 then CloseHandle(StdOutPipeW); inherited; end; procedure TConsoleThread.DoStdOut; begin if assigned(FOnStdOut) then FOnStdOut(self,StdOutStr); end; procedure TConsoleThread.Execute; var si:TStartupInfo; pi:TProcessInformation; bytesRead:DWORD; begin try GetStartupInfo(si); si.cb:=sizeof(TStartupInfo); si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; si.hStdInput:=StdInPipeR; si.hStdOutput:=StdOutPipeW; si.hStdError:=StdOutPipeW; si.wShowWindow:=SW_HIDE; Win32Check(CreateProcess(nil,PChar(FCMD),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil ,si,pi)); while not Terminated do begin if WaitForSingleObject(pi.hProcess,0)=WAIT_OBJECT_0 then begin GetExitCodeProcess(pi.hProcess,FExitCode); Terminate; end; PeekNamedPipe(StdOutPipeR,nil,0,nil,@bytesRead,nil); if bytesRead>0 then begin SetLength(StdOutStr,bytesRead); if not ReadFile(StdOutPipeR,PChar(StdOutStr)^,bytesRead,bytesRead,nil) then RaiseLastOSError; SetLength(StdOutStr,bytesRead); OemToChar(PChar(StdOutStr),PChar(StdOutStr)); Synchronize(DoStdOut); end; end; finally CloseHandle(pi.hProcess); CloseHandle(pi.hThread); end; end; procedure TConsoleThread.WriteToStdIn(const Str: string); var bytes:DWORD; begin CharToOem(PChar(Str),PChar(Str)); Win32Check(WriteFile(StdInPipeW,PChar(str)^,Length(Str),bytes,nil)); if bytes<>Length(Str) then raise Exception.Create("StdIn write error"); end; end.
пользование:
procedure TForm1.FormCreate(Sender: TObject); begin ConsoleThread:=TConsoleThread.Create("C:\WINDOWS\system32\cmd.exe",true); ConsoleThread.OnStdOut:=OnStdOut; ConsoleThread.OnTerminate:=OnTerminate; ConsoleThread.FreeOnTerminate:=true; ConsoleThread.Resume; end; procedure TForm1.OnTerminate(Sender: TObject); begin Application.Terminate; end; procedure TForm1.OnStdOut(Sender:TObject;const Str:string); begin Memo1.lines.add(Str); end; procedure TForm1.Button2Click(Sender: TObject); begin ConsoleThread.WriteToStdIn(Edit1.Text+#13#10); end;

> Slym © (29.11.08 17:55) [18]

> на коленке переписывается старый код...

Вот. И меня чрез оную коленку хочешь.. переписать.
Давай уж по-существу.

--
Regards, LVT.

Leonid Troyanovsky © (29.11.08 20:44) [21]
[20] проверено... получится мини гуи аналог консоли, но нет обработки eof которая нужна например в copy con txt.txt

Помогите оптимизировать код (выполнения в консоли)! Найти похожие ветки