Commit 49cf3958 authored by Michael Van Canneyt's avatar Michael Van Canneyt
Browse files

* Changed CommandLine/ApplicationName to Executable and Parameters (12034 and 14446)

git-svn-id: trunk@17379 -
parent 840d06dd
......@@ -45,11 +45,14 @@ interface
TProcessForkEvent = procedure;
{$endif UNIX}
{ TProcess }
TProcess = Class (TComponent)
Private
FProcessOptions : TProcessOptions;
FStartupOptions : TStartupOptions;
FProcessID : Integer;
FTerminalProgram: String;
FThreadID : Integer;
FProcessHandle : Thandle;
FThreadHandle : Thandle;
......@@ -60,6 +63,8 @@ interface
FCurrentDirectory : String;
FDesktop : String;
FEnvironment : Tstrings;
FExecutable : String;
FParameters : TStrings;
FShowWindow : TShowWindowOptions;
FInherithandles : Boolean;
{$ifdef UNIX}
......@@ -72,10 +77,13 @@ interface
dwx,
dwYcountChars,
dwy : Cardinal;
FXTermProgram: String;
Procedure FreeStreams;
Function GetExitStatus : Integer;
Function GetRunning : Boolean;
Function GetWindowRect : TRect;
procedure SetCommandLine(const AValue: String);
procedure SetParameters(const AValue: TStrings);
Procedure SetWindowRect (Value : TRect);
Procedure SetShowWindow (Value : TShowWindowOptions);
Procedure SetWindowColumns (Value : Cardinal);
......@@ -88,6 +96,7 @@ interface
procedure SetProcessOptions(const Value: TProcessOptions);
procedure SetActive(const Value: Boolean);
procedure SetEnvironment(const Value: TStrings);
Procedure ConvertCommandLine;
function PeekExitStatus: Boolean;
Protected
FRunning : Boolean;
......@@ -98,6 +107,7 @@ interface
procedure CloseProcessHandles; virtual;
Procedure CreateStreams(InHandle,OutHandle,ErrHandle : Longint);virtual;
procedure FreeStream(var AStream: THandleStream);
procedure Loaded; override;
Public
Constructor Create (AOwner : TComponent);override;
Destructor Destroy; override;
......@@ -125,8 +135,10 @@ interface
{$endif UNIX}
Published
Property Active : Boolean Read GetRunning Write SetActive;
Property ApplicationName : String Read FApplicationName Write SetApplicationName;
Property CommandLine : String Read FCommandLine Write FCommandLine;
Property ApplicationName : String Read FApplicationName Write SetApplicationName; deprecated;
Property CommandLine : String Read FCommandLine Write SetCommandLine ; deprecated;
Property Executable : String Read FExecutable Write FExecutable;
Property Parameters : TStrings Read FParameters Write SetParameters;
Property ConsoleTitle : String Read FConsoleTitle Write FConsoleTitle;
Property CurrentDirectory : String Read FCurrentDirectory Write FCurrentDirectory;
Property Desktop : String Read FDesktop Write FDesktop;
......@@ -143,10 +155,18 @@ interface
Property WindowTop : Cardinal Read dwY Write SetWindowTop ;
Property WindowWidth : Cardinal Read dwXSize Write SetWindowWidth;
Property FillAttribute : Cardinal read FFillAttribute Write FFillAttribute;
Property XTermProgram : String Read FXTermProgram Write FXTermProgram;
end;
EProcess = Class(Exception);
{$ifdef unix}
Var
TryTerminals : Array of string;
XTermProgram : String;
Function DetectXTerm : String;
{$endif unix}
implementation
{$ifdef WINDOWS}
......@@ -162,8 +182,67 @@ implementation
{$endif UNIX}
Resourcestring
SNoCommandLine = 'Cannot execute empty command-line';
SErrNoSuchProgram = 'Executable not found: "%s"';
SNoCommandLine = 'Cannot execute empty command-line';
SErrNoSuchProgram = 'Executable not found: "%s"';
SErrNoTerminalProgram = 'Could not detect X-Terminal program';
Procedure CommandToList(S : String; List : TStrings);
Function GetNextWord : String;
Const
WhiteSpace = [' ',#8,#10];
Literals = ['"',''''];
Var
Wstart,wend : Integer;
InLiteral : Boolean;
LastLiteral : char;
begin
WStart:=1;
While (WStart<=Length(S)) and (S[WStart] in WhiteSpace) do
Inc(WStart);
WEnd:=WStart;
InLiteral:=False;
LastLiteral:=#0;
While (Wend<=Length(S)) and (Not (S[Wend] in WhiteSpace) or InLiteral) do
begin
if S[Wend] in Literals then
If InLiteral then
InLiteral:=Not (S[Wend]=LastLiteral)
else
begin
InLiteral:=True;
LastLiteral:=S[Wend];
end;
inc(wend);
end;
Result:=Copy(S,WStart,WEnd-WStart);
if (Length(Result) > 0)
and (Result[1] = Result[Length(Result)]) // if 1st char = last char and..
and (Result[1] in Literals) then // it's one of the literals, then
Result:=Copy(Result, 2, Length(Result) - 2); //delete the 2 (but not others in it)
While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
inc(Wend);
Delete(S,1,WEnd-1);
end;
Var
W : String;
begin
While Length(S)>0 do
begin
W:=GetNextWord;
If (W<>'') then
List.Add(W);
end;
end;
{$i process.inc}
......@@ -177,11 +256,13 @@ implementation
FForkEvent:=nil;
{$endif UNIX}
FEnvironment:=TStringList.Create;
FParameters:=TStringList.Create;
end;
Destructor TProcess.Destroy;
begin
FParameters.Free;
FEnvironment.Free;
FreeStreams;
CloseProcessHandles;
......@@ -231,6 +312,13 @@ procedure TProcess.FreeStream(var AStream: THandleStream);
FreeAndNil(AStream);
end;
procedure TProcess.Loaded;
begin
inherited Loaded;
If (csDesigning in ComponentState) and (CommandLine<>'') then
ConvertCommandLine;
end;
procedure TProcess.CloseInput;
begin
FreeStream(THandleStream(FInputStream));
......@@ -297,6 +385,20 @@ procedure TProcess.CloseStderr;
end;
end;
procedure TProcess.SetCommandLine(const AValue: String);
begin
if FCommandLine=AValue then exit;
FCommandLine:=AValue;
If Not (csLoading in ComponentState) then
ConvertCommandLine;
end;
procedure TProcess.SetParameters(const AValue: TStrings);
begin
if FParameters=AValue then exit;
FParameters:=AValue;
end;
Procedure TProcess.SetWindowRect (Value : Trect);
begin
Include(FStartupOptions,suoUseSize);
......@@ -350,4 +452,15 @@ procedure TProcess.SetEnvironment(const Value: TStrings);
FEnvironment.Assign(Value);
end;
procedure TProcess.ConvertCommandLine;
begin
FParameters.Clear;
CommandToList(CommandLine,FParameters);
If FParameters.Count>0 then
begin
Executable:=FParameters[0];
FParameters.Delete(0);
end;
end;
end.
This file describes the TProcess object.
Important remark:
As of version 2.5.1 (April 2011) the CommandLine and ApplicationName
properties are deprecated in favour of properties Executable and Parameters.
If CommandLine or ApplicationName is set, it will automatically be converted
to Executable and Parameters. If you wish to use the latter 2 properties,
simply clear the CommandLine and ApplicationName properties.
The TProcess object provides an easy way to start and manipulate
the running of other programs (processes) by your application.
On top of that, it allows you to redirect the program's input, output
and standard error to streams that are readable/writeable by your
program.
It is a descendent class of TObject, but this is easily changeable to
TComponent, should you desire to do so. None of the properties will
conflict with the existing properties of TComponent.
It is a descendent class of TComponent.
Furthermore it is written in such a way that it is easily extensible,
although most of the properties that a Process has, are accessible and
......@@ -19,22 +25,12 @@ In what follows, is a description of the object's methods and properties.
The following two types control the creation of the TProcess Object.
See The constructor description for a description on what they do.
TProcessOptions = (poExecuteOnCreate,poRunSuspended,poUsePipes,
poNoConsole,poStderrToOutPut,poWaitOnExit);
TProcessOptions = (poExecuteOnCreate,poRunSuspended,poUsePipes,poNewConsole,
poNoConsole,poStderrToOutPut,poWaitOnExit);
TCreateOptions = Set of TPRocessOptions;
Constructor Create (Const ACommandline : String;
Options : TCreateOptions);
This creates an TPRocess object.
ACommandline is the commandline to execute, including any options
you wish to pass to the program. If you don't specify an explicit path
Windows will look for your program in the Windows directory and in the
path.
Options control the behaviour of the object. It can be a set of the
following constants:
......@@ -74,6 +70,17 @@ poWaitOnExit
This option will be ignored if you also specified ExecuteOnCreate and
CreateSuspended.
poNewConsole
If you specify this option, then the Execute method will open a console to
execute the program in. On windows, the standard console is used.
On Unix, the console program is detected as follows:
- XTermProgram is used if it is set.
- the terminals in TryTerminals are tested
- the 'DESKTOP_SESSION' variable is examined and the corresponding
terminal is tested for availability.
- A set of standard terminals is tested:
('x-terminal-emulator','xterm','aterm','wterm','rxvt')
if none of these can be detected, an exception is raised.
Destructor Destroy; virtual;
......@@ -109,10 +116,18 @@ Function WaitOnExit : Boolean;
Property ApplicationName : String;
Sets the name of the application.
Property CommandLine : String;
Read-Only
contains the commandline of the application, as set by the create
method of TProcess.
Property CommandLine : String; (Deprecated)
contains the commandline of the application. method of TProcess.
If Set, it overrides the Executable and Parameters properties
Property Executable : String;
The binary program to be executed. It will be searched in the PATH.
Property Parameters : TStrings
The command-line parameters to be passed to Executable. One parameter per
line must be specified. If 2 or more words, separated by a space, are detected
in an argument, they will be treated as 1 argument and quoted if the OS
requires it.
Property ConsoleTitle : String;
For console applications only :
......
......@@ -75,65 +75,71 @@ procedure TProcess.CloseProcessHandles;
end;
Procedure CommandToList(S : String; List : TStrings);
Function GetNextWord : String;
Function DetectXterm : String;
Const
WhiteSpace = [' ',#8,#10];
Literals = ['"',''''];
Var
Wstart,wend : Integer;
InLiteral : Boolean;
LastLiteral : char;
Function TestTerminal(S : String) : Boolean;
begin
WStart:=1;
While (WStart<=Length(S)) and (S[WStart] in WhiteSpace) do
Inc(WStart);
WEnd:=WStart;
InLiteral:=False;
LastLiteral:=#0;
While (Wend<=Length(S)) and (Not (S[Wend] in WhiteSpace) or InLiteral) do
begin
if S[Wend] in Literals then
If InLiteral then
InLiteral:=Not (S[Wend]=LastLiteral)
else
begin
InLiteral:=True;
LastLiteral:=S[Wend];
end;
inc(wend);
end;
Result:=Copy(S,WStart,WEnd-WStart);
if (Length(Result) > 0)
and (Result[1] = Result[Length(Result)]) // if 1st char = last char and..
and (Result[1] in Literals) then // it's one of the literals, then
Result:=Copy(Result, 2, Length(Result) - 2); //delete the 2 (but not others in it)
Result:=FileSearch(s,GetEnvironmentVariable('PATH'),False)<>'';
end;
While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
inc(Wend);
Delete(S,1,WEnd-1);
Function TestTerminals(Terminals : Array of String) : Boolean;
Var
I : integer;
begin
I:=Low(Terminals);
Result:=False;
While (Not Result) and (I<=High(Terminals)) do
begin
Result:=TestTerminal(Terminals[i]);
If Result then
XTermProgram:=Terminals[i];
end;
end;
Const
Konsole = 'konsole';
GNomeTerm = 'gnome-terminal';
DefaultTerminals : Array [1..5] of string
= ('x-terminal-emulator','xterm','aterm','wterm','rxvt');
Var
W : String;
D :String;
begin
While Length(S)>0 do
If (XTermProgram='') then
begin
W:=GetNextWord;
If (W<>'') then
List.Add(W);
// try predefined
If Length(TryTerminals)>0 then
TestTerminals(TryTerminals);
// try session-specific terminal
if (XTermProgram='') then
begin
D:=LowerCase(GetEnvironmentVariable('DESKTOP_SESSION'));
If (D='kde') then
begin
TestTerminal('konsole');
end
else if (D='gnome') then
begin
TestTerminal('gnome-terminal');
end
else if (D='windowmaker') then
begin
If not TestTerminal('aterm') then
TestTerminal('wterm');
end;
end;
if (XTermProgram='') then
TestTerminals(DefaultTerminals)
end;
Result:=XTermProgram;
If (Result='') then
Raise EProcess.Create(SErrNoTerminalProgram);
end;
Function MakeCommand(P : TProcess) : PPchar;
{$ifdef darwin}
......@@ -151,22 +157,23 @@ procedure TProcess.CloseProcessHandles;
G : String;
begin
if (P.ApplicationName='') then
begin
If (P.CommandLine='') then
Raise EProcess.Create(SNoCommandline);
Cmd:=P.CommandLine;
end
else
begin
If (P.CommandLine='') then
Cmd:=P.ApplicationName
else
Cmd:=P.CommandLine;
end;
If (P.ApplicationName='') and (P.CommandLine='') and (P.Executable='') then
Raise EProcess.Create(SNoCommandline);
S:=TStringList.Create;
try
CommandToList(Cmd,S);
if (P.ApplicationName='') and (P.CommandLine='') then
begin
S.Assign(P.Parameters);
S.Insert(0,P.Executable);
end
else
begin
If (P.CommandLine='') then
Cmd:=P.ApplicationName
else
Cmd:=P.CommandLine;
CommandToList(Cmd,S);
end;
if poNewConsole in P.Options then
begin
{$ifdef haiku}
......@@ -190,7 +197,10 @@ procedure TProcess.CloseProcessHandles;
S.Insert(0,Format('%dx%d',[P.dwXCountChars,P.dwYCountChars]));
S.Insert(0,'-geometry');
end;
S.Insert(0,'xterm');
If (P.XTermProgram<>'') then
S.Insert(0,P.XTermProgram)
else
S.Insert(0,DetectXterm);
{$endif}
end;
{$ifndef haiku}
......
......@@ -155,9 +155,19 @@ procedure TProcess.CloseProcessHandles;
end;
end;
Function MaybeQuote(Const S : String) : String;
begin
If (Pos(' ',S)<>0) then
Result:='"'+S+'"'
else
Result:=S;
end;
Procedure TProcess.Execute;
Var
i : Integer;
PName,PDir,PCommandLine : PChar;
FEnv: pointer;
FCreationFlags : Cardinal;
......@@ -166,27 +176,35 @@ procedure TProcess.CloseProcessHandles;
FProcessInformation : TProcessInformation;
FStartupInfo : STARTUPINFO;
HI,HO,HE : THandle;
Cmd : String;
begin
FInheritHandles:=True;
PName:=Nil;
PCommandLine:=Nil;
PDir:=Nil;
if (FApplicationName='') and (FCommandLine='') and (FExecutable='') then
Raise EProcess.Create(SNoCommandline);
if (FApplicationName='') then
begin
If (FCommandLine='') then
Raise EProcess.Create(SNoCommandline);
PCommandLine:=Pchar(FCommandLine)
PCommandLine:=Pchar(FCommandLine)
end
else
begin
PName:=Pchar(FApplicationName);
If (FCommandLine='') then
PCommandLine:=Pchar(FApplicationName)
else
PCommandLine:=Pchar(FCommandLine)
end;
PName:=Pchar(FApplicationName);
If (FCommandLine<>'') then
PCommandLine:=Pchar(FCommandLine)
else if (Fexecutable='') then
PCommandLine:=Pchar(FApplicationName)
else
begin
Cmd:=MaybeQuote(Executable);
For I:=0 to Parameters.Count-1 do
Cmd:=Cmd+' '+MaybeQuote(Parameters[i]);
PCommandLine:=PChar(Cmd);
end;
end;
If FCurrentDirectory<>'' then
PDir:=Pchar(FCurrentDirectory);
if FEnvironment.Count<>0 then
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment