Friday, January 21, 2011

Fungsi Execute and Wait

Buat sebuah proyek berisi 1 TLabel, 1 TEdit dan 1 TButton dengan tampilan sbb:
Berikut source code-nya:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
function ExecuteAndWait(FileName: String; Visibility  : Integer ) : Cardinal;
var
  AppName      : array[0..512] of char;
  CurrentDir   : array[0..255] of char;
  WorkDir      : String;
  StartupInfo  : TStartupInfo;
  ProcessInfo  : TProcessInformation;
begin
  StrPCopy(AppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(CurrentDir, WorkDir);
 
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
 
  StartupInfo.cb          := Sizeof(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
 
  if (not CreateProcess(nil, AppName, nil, nil, false,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil, CurrentDir, StartupInfo, ProcessInfo)) then
  begin
    Result := $FFFFFFFF; {Set pointer to PROCESS_INF}
    MessageBox(Application.Handle,
      PChar(SysErrorMessage(GetLastError)),'The Error!', 0 );
  end
  else
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if ExecuteAndWait(Edit1.Text, SW_NORMAL) <> $FFFFFFFF then
    ShowMessage(Edit1.Text + ' done.');
end;
 
end.

0 comments:

Post a Comment

Twitter Delicious Facebook Digg Stumbleupon Favorites More

 
Design by Kang Iwan K-sev | Thank's for your visit To My Site - Ridwan Mulyana | Cibeureum