Допилил я таки модуль для запуска консольных приложений, чтобы он нормально работал в XE
Кому не влом, протестируйте на семерке к примеру, ну или на любой дельфе которая не юникодовская.
Код:
unit ConsoleAppRunner;
interface
uses
Classes;
procedure RunConsoleApplication(CmdLine,Params:String;OutStrings:TStrings);
implementation
uses
SysUtils,Windows;
const
UnprintableSymbols = [
#$00,#$01,#$02,#$03,#$04,#$05,#$06,#$07,#$08,#$09,#$0A,#$0B,#$0C,#$0D,#$0E,#$0F,
#$10,#$11,#$12,#$13,#$14,#$15,#$16,#$17,#$18,#$19,#$1A,#$1B,#$1C,#$1D,#$1E,#$1F,
#$7F
];
type
TAnsiBuf = array [0..1023] of AnsiChar;
TCharBuf = array [0..1023] of Char;
procedure MoveLeft(var Data:TAnsiBuf; From,Len,Shift:integer);
var
i:integer;
begin
for i := From to From+Len do
Data[i]:=Data[i-Shift];
end;
procedure AnsiBufToCharBuf(AnsiBuf:TAnsiBuf;var CharBuf:TCharBuf;Len:integer);
var
i:integer;
begin
for I := 0 to Len do
begin
if CharInSet(AnsiBuf[i],UnprintableSymbols) then
CharBuf[i]:=Char(AnsiBuf[i])
else
OemToChar(@AnsiBuf[i],@CharBuf[i]);
end;
end;
procedure RunConsoleApplication(CmdLine,Params:String;OutStrings:TStrings);
var
securityattributes: TSecurityAttributes;
startupinfo: TStartupInfo;
processinformation: TProcessInformation;
hPipeInputRead: THandle;
hPipeInputWrite: THandle;
hPipeOutputRead: THandle;
hPipeOutputWrite: THandle;
WaitResult:Cardinal;
AnsiBuf: TAnsiBuf;
CharBuf: TCharBuf;
dummy: Cardinal;
s:string;
begin
// OutStrings.Append(#13#10); //<---------
securityattributes.nLength:=SizeOf(TSecurityAttributes);
securityattributes.lpSecurityDescriptor:=nil;
securityattributes.bInheritHandle:=True;
CreatePipe(hPipeInputRead, hPipeInputWrite, @securityattributes, 0);
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @securityattributes, 0);
ZeroMemory(@startupinfo, SizeOf(TStartupInfo));
ZeroMemory(@processinformation, SizeOf(TProcessInformation));
with startupinfo do
begin
cb:=SizeOf(TStartupInfo);
dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow:=SW_HIDE;
hStdInput:=hPipeInputRead;
hStdOutput:=hPipeOutputWrite;
hStdError:=hPipeOutputWrite;
end;
OutStrings.BeginUpdate;
OutStrings.Append(CmdLine+' '+Params);
OutStrings.EndUpdate;
if CreateProcess(nil, PChar(CmdLine+' '+Params), nil, nil, True, CREATE_NEW_CONSOLE,
nil, PChar(ExtractFileDir(CmdLine)), startupinfo, processinformation) then
begin
repeat
WaitResult:=WaitForSingleObject(processinformation.hProcess, 100);
if ReadFile(hPipeOutputRead, AnsiBuf, Length(AnsiBuf), dummy, nil) then
begin
AnsiBufToCharBuf(AnsiBuf, CharBuf, dummy);
OutStrings.BeginUpdate;
OutStrings.Text:=OutStrings.Text+Copy(CharBuf, 1, dummy);
// if Pos(#8,OutStrings.Text)>0 then //<---------
// begin //<---------
// s:=OutStrings.Text; //<---------
// Delete(s,Pos(#8,s)-3,4); //<---------
// OutStrings.Text:=s; //<---------
// end; //<---------
OutStrings.EndUpdate;
end;
until WaitResult<>WAIT_TIMEOUT;
CloseHandle(processinformation.hProcess);
end
else
begin
OutStrings.BeginUpdate;
OutStrings.Append(SysErrorMessage(GetLastError));
OutStrings.EndUpdate;
end;
CloseHandle(hPipeInputWrite);
CloseHandle(hPipeInputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeOutputRead);
end;
end.
на закомментаренные строчки внимания не обращайте, это мне нужно для внутренних нужд (тафталогия блин).
пример вызова:
Код:
uses ConsoleAppRunner;
...
RunConsoleApplication('c:\windows\system32\ping.exe','192.168.104.104',ListBox1.Items);
ЗЫЖ Естественно консоль эмулируется не на 100%
__________________
Некоторые программисты настолько ленивы, что сразу пишут рабочий код.
Если вас наказали ни за что - радуйтесь: вы ни в чем не виноваты.
|