unit UruchamianieAplikacji;

interface

uses
  SysUtils, Classes, Windows;

const
  BELOW_NORMAL_PRIORITY_CLASS=Integer($4000);
  ABOVE_NORMAL_PRIORITY_CLASS=Integer($8000);

type
  TPriorities = (prIdle=IDLE_PRIORITY_CLASS,
                prBelowNormal=BELOW_NORMAL_PRIORITY_CLASS,
                prNormal=NORMAL_PRIORITY_CLASS,
                prAboveNormal=ABOVE_NORMAL_PRIORITY_CLASS,
                prHigh=HIGH_PRIORITY_CLASS,
                prRealtime=REALTIME_PRIORITY_CLASS);
  //Podobny do TWindowState, ale dodany swHide i wartosci odpowiadaja stałym z WinAPI
  TWindowStyles = (swNormal=SW_NORMAL,
                   swHide=SW_HIDE,
                   swMaximize=SW_MAXIMIZE,
                   swMinimize=SW_MINIMIZE);

  TCreateProcess = class(TComponent)
  private
    FFileName :String;
    FDirectory :String;
    FDefaultPosition :Boolean;
    FDefaultSize :Boolean;

  protected
    FPriority :TPriorities;
    FLeft :Integer;
    FTop :Integer;
    FWidth :Integer;
    FHeight :Integer;
    FWindowStyle :TWindowStyles;
    FProcessInformation :TProcessInformation;

  public
    constructor Create(AOwner: TComponent); override;
    function Execute :Boolean;
    function ExecuteAndWait :Boolean;

  published
    property FileName :String read FFileName write FFileName;
    property Priority :TPriorities read FPriority write FPriority default prNormal;
    property Directory :String read FDirectory write FDirectory;
    property Left :Integer read FLeft write FLeft;
    property Top :Integer read FTop write FTop;
    property Width :Integer read FWidth write FWidth;
    property Height :Integer read FHeight write FHeight;
    property DefaultPosition :Boolean read FDefaultPosition write FDefaultPosition default True;
    property DefaultSize :Boolean read FDefaultSize write FDefaultSize default True;
    property WindowStyle :TWindowStyles read FWindowStyle write FWindowStyle default swNormal;
    property ProcessInformation :TProcessInformation read FProcessInformation;
  end;

procedure Register;

implementation

constructor TCreateProcess.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FileName:='';
Priority:=prNormal;
Directory:='';
Left:=0;
Top:=0;
Width:=500;
Height:=100;
DefaultPosition:=True;
DefaultSize:=True;
WindowStyle:=swNormal;
FillChar(FProcessInformation, sizeof(TProcessInformation), 0);
end;

function TCreateProcess.Execute() :Boolean;
var
  StartupInfo :TStartupInfo;
  LProcessInformation :TProcessInformation;
  PFileName :PChar;
  PDirectory :PChar;
  Flags :Cardinal;
begin
Result:=False;
if FFileName='' then Exit;

PFileName:=PChar(FFileName);
PDirectory:=PChar(FDirectory);
if Directory='' then PDirectory:=nil;

//Inicjowanie struktury zawierajacej parametry uruchomienia aplikacji
FillChar(StartupInfo, sizeof(TStartupInfo), 0);
StartupInfo.cb:=sizeof(TStartupInfo);
StartupInfo.lpDesktop:=nil; //desktop z aplikacji, ktora uruchamia
StartupInfo.lpTitle:=nil; //tytul okna konsoli, jezeli taka jest tworzona
StartupInfo.dwX:=FLeft;
StartupInfo.dwY:=FTop;
StartupInfo.dwXSize:=FWidth;
StartupInfo.dwYSize:=FHeight;
Flags:=STARTF_USESHOWWINDOW;
if not FDefaultPosition then Flags:=Flags or STARTF_USEPOSITION;
if not FDefaultSize then Flags:=Flags or STARTF_USESIZE;
StartupInfo.dwFlags:=Flags;
StartupInfo.wShowWindow:=Word(FWindowStyle);

//Zerowanie struktury do ktorej zapisane beda informacje o procesie
FillChar(LProcessInformation, sizeof(TProcessInformation), 0);

//Uruchamianie procesu
Result:=CreateProcess(nil,
                     PFileName,
                     nil, //korzystamy z domyslnego opisu bezpieczenstwa procesu
                     nil, //korzystamy z domyslnego opisu bezpieczenstwa watku
                     False, //czy uchwyty dziedziczone w procesie
                     Cardinal(FPriority), //priorytet
                     nil, //korzystanie ze zmiennych srodowiska aplikacji wywolujacej
                     PDirectory, //katalog biezacy aplikacji
                     StartupInfo, //parametry uruchomienia aplikacji
                     LProcessInformation //informacje o uruchomionej aplikacji
                     );

FProcessInformation:=LProcessInformation;
end;

function TCreateProcess.ExecuteAndWait :Boolean;
begin
Result:=Execute; //uruchamia proces
if not Result then Exit;
WaitForSingleObject(ProcessInformation.hProcess,INFINITE); //czeka na zakonczenie
FillChar(FProcessInformation,sizeof(TProcessInformation),0); //czysci ProcessInformation
end;

procedure Register;
begin
  RegisterComponents('JM', [TCreateProcess]);
end;

end.
