- Код: Выделить всё
procedure tmainfo.get_c(const sender: TObject);
var
g_c:TgetConsoleTh;
begin
g_c:=TgetConsoleTh.create('/usr/bin/top');
end;
и собственно поток для обработки(прототип)
- Код: Выделить всё
unit getconsole_th;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}//{$apptype console}
interface
uses
classes,msewidgets;
type
TgetConsoleTh=class(Tthread)
cur_data:string;
constructor create(run:string);
procedure dummy;
private
sh_line:string;
protected
procedure execute;override;
end;
//const
implementation
uses sysutils,libc,main;
//const
constructor TgetConsoleTh.create(run:string);
begin
inherited Create(False);
sh_line:=run;
//insert some code
end;
procedure TgetConsoleTh.dummy;
begin
end;
procedure TgetConsoleTh.execute;
var
CmdLine: string;
Output: PIOFile;
Buffer: PChar;
TempString: string;
Line_: string;
BytesRead: Integer;
Cmd_Result__:string;
const
BufferSize: Integer = 1000;
begin
showmessage('Run '+sh_line);
Output := popen(PChar(sh_line), 'r');
GetMem(Buffer, BufferSize);
if Assigned(Output) then
try
while feof(Output) = 0 do
begin
BytesRead := Libc.fread(Buffer, 1, BufferSize, Output);
SetLength(TempString, Length(TempString)+BytesRead);
memcpy(@TempString[length(TempString)-(BytesRead-1)], Buffer, BytesRead);
showmessage('tempstr '+TempString);
while Pos(#10, TempString) > 0 do
begin
Line_ := Copy(TempString, 1, Pos(#10, TempString)-1);
cur_data:=line_;
if line_<>'' then Cmd_Result__:= Cmd_Result__+Line_+#13;
TempString := copy(TempString, Pos(#10, TempString)+1, Length(TempString));
end;
showmessage('curdata '+cur_data);
end;
finally
Libc.pclose(output);
wait(nil);
FreeMem(Buffer,BufferSize);
end;
end;
end.
Итак если вызвать /usr/bin/free то увидим результат выполнения команды, но если вызвать top код работает только в MSE, или если запустить из терминала gnome (gnome-terminal).
Почему так происходит? Как правильно перехватить данные?
PS опция {$apptype console} не влияет на результат.(showmessage для отладки вне MSE)
PSS. хочу напистать свой вронтэнд для wget и arai2c.