{***************************************************************************}
{ }
{ DelphiUIAutomation }
{ }
{ Copyright 2015 JHC Systems Limited }
{ }
{***************************************************************************}
{ }
{ Licensed under the Apache License, Version 2.0 (the "License"); }
{ you may not use this file except in compliance with the License. }
{ You may obtain a copy of the License at }
{ }
{ http://www.apache.org/licenses/LICENSE-2.0 }
{ }
{ Unless required by applicable law or agreed to in writing, software }
{ distributed under the License is distributed on an "AS IS" BASIS, }
{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. }
{ See the License for the specific language governing permissions and }
{ limitations under the License. }
{ }
{***************************************************************************}
unit DelphiUIAutomation.Client;
interface
uses
generics.collections,
winapi.windows,
TlHelp32,
DelphiUIAutomation.Window,
UIAutomationClient_TLB;
type
IAutomationApplication = interface
['{82CC20ED-7DA4-48D4-B46D-09D059606A15}']
procedure WaitWhileBusy;
function GetAttached: boolean;
///
/// Gets whether the process was attached or started
///
property IsAttached : boolean read GetAttached;
///
/// Kills the application being automated
///
procedure Kill;
end;
///
/// The main automation application wrapper
///
TAutomationApplication = class (TInterfacedObject, IAutomationApplication)
strict private
FProcess : THandle;
FAttached : boolean;
private
function getProcID: THandle;
function GetAttached: boolean;
public
///
/// Creates an application
///
constructor Create(process: THandle; IsAttached : boolean = false);
///
/// Launches an application
///
class function Launch(executable, parameters : String) : IAutomationApplication;
///
/// Attaches to an already running application
///
class function Attach (process: TProcessEntry32) : IAutomationApplication;
///
/// Launches or attaches to an application
///
class function LaunchOrAttach(executable, parameters : String) : IAutomationApplication;
///
/// Kills the application being automated
///
procedure Kill;
///
/// Waits while the application is busy - INFINITE timeout
///
procedure WaitWhileBusy; overload;
///
/// Waits while the application is busy, with a given timeout
///
procedure WaitWhileBusy(timeout : DWORD); overload;
///
/// Saves the current screen image to a file
///
class procedure SaveScreenshot;
///
/// Gets the process
///
property Process : THandle read getProcID;
///
/// Gets whether the process was attached or started
///
property IsAttached : boolean read GetAttached;
end;
implementation
uses
sysutils,
ActiveX,
DelphiUIAutomation.Exception,
DelphiUIAutomation.Processes,
DelphiUIAutomation.Utils,
DelphiUIAutomation.Automation,
DelphiUIAutomation.ScreenShot;
{ TAutomationApplication }
class function TAutomationApplication.Attach(process: TProcessEntry32): IAutomationApplication;
//var
// info : TProcessInformation;
begin
// info.hProcess := process.th32ProcessID;
// info.hThread := 0;
// info.dwProcessId := 0;
// info.dwThreadId := 0;
result := TAutomationApplication.Create(process.th32ProcessID, true);
end;
constructor TAutomationApplication.Create(process: THandle; IsAttached : boolean = false);
begin
FProcess := process;
FAttached := IsAttached;
end;
function TAutomationApplication.GetAttached: boolean;
begin
result := FAttached;
end;
function TAutomationApplication.getProcID: THandle;
begin
result := FProcess;
end;
function TerminateProcessByID(ProcessID: Cardinal; IsAttached : boolean): Boolean;
var
hProcess : THandle;
begin
Result := False;
// If we attached to an already running process, then we need to open the handle
if (IsAttached) then
begin
hProcess := OpenProcess(PROCESS_TERMINATE,False,ProcessID);
if hProcess > 0 then
try
Result := Win32Check(TerminateProcess(hProcess,0));
finally
CloseHandle(hProcess);
end;
end
else
begin
try
Result := Win32Check(TerminateProcess(ProcessID,0));
finally
CloseHandle(ProcessID);
end;
end;
end;
procedure TAutomationApplication.Kill;
begin
if FProcess <> 0 then
begin
TerminateProcessByID(FProcess, self.FAttached);
end;
end;
class function TAutomationApplication.Launch(executable,
parameters: String): IAutomationApplication;
var
info : TProcessInformation;
actualParameters : string;
begin
if (parameters <> '') then
begin
actualParameters := string.Format('%s %s',
[executable, parameters]);
end;
info := ExecNewProcess(executable, actualParameters, false);
result := TAutomationApplication.Create(info.hProcess);
end;
class function TAutomationApplication.LaunchOrAttach(executable,
parameters: String): IAutomationApplication;
var
exename : string;
Processes : TAutomationProcesses;
process : TProcessEntry32;
begin
exename := ExtractFileName(executable);
processes := TAutomationProcesses.create;
try
// See whether we can get hold of the process
try
// Found a running application
process := processes.FindProcess(exename);
result := self.Attach(process);
except on EDelphiAutomationException do
result := self.Launch(executable, parameters);
end;
finally
processes.Free;
end;
end;
class procedure TAutomationApplication.SaveScreenshot;
var
screenshot : TAutomationScreenshot;
begin
screenshot := TAutomationScreenshot.Create;
try
screenshot.SaveCurrentScreen;
finally
screenshot.Free;
end;
end;
procedure TAutomationApplication.WaitWhileBusy(timeout: DWORD);
begin
WaitForInputIdle(self.FProcess, timeout);
end;
procedure TAutomationApplication.WaitWhileBusy;
begin
WaitWhileBusy(INFINITE);
end;
end.