Saturday 10 December 2016

Simple background tasks with OtlParallel - Life after 2.1: Async redux

OtlParallel unit defines four overloaded Async methods
Parallel.Async(
   class procedure Async(task: TProc; taskConfig: IOmniTaskConfig = nil); overload;
class procedure Async(task: TOmniTaskDelegate; 
  taskConfig: IOmniTaskConfig = nil); overload;
class procedure Async(task: TProc; onTermination: TProc; 
  taskConfig: IOmniTaskConfig = nil); overload;
class procedure Async(task: TOmniTaskDelegate; onTermination: TProc;
  taskConfig: IOmniTaskConfig = nil); overload;

As it turned out, two of them are not necessary anymore. Since the introduction of the taskConfig parameter, termination procedure can also be specified by setting taskConfig.OnTerminated.

To make the matter simpler, I’ve removed both Asyncs that accept the onTermination parameter.
class procedure Async(task: TProc; taskConfig: IOmniTaskConfig = nil); overload;
class procedure Async(task: TOmniTaskDelegate; 
  taskConfig: IOmniTaskConfig = nil); overload;
The old way of setting termination handler …
Parallel.Async(
    procedure
    begin
      // executed in background thread
      Sleep(500);
      MessageBeep($FFFFFFFF);
    end,
    procedure (const task: IOmniTaskControl)
    begin
      // executed in main thread
      btnAsync.Enabled := true;
    end
    )
    );
… must be replaced with slightly more verbose
Parallel.Async(
    procedure
    begin
      // executed in background thread
      Sleep(500);
      MessageBeep($FFFFFFFF);
    end,
    Parallel.TaskConfig.OnTerminated(
      procedure (const task: IOmniTaskControl)
      begin
        // executed in main thread
        btnAsync.Enabled := true;
      end
    )
  );

Source : Here


Thursday 8 December 2016

FastMM – Preparing your apps to report memory leaks

One of the most challenging parts of inheriting a legacy project is to fix the memory leaks that most often are hiding in the code. A while ago, while dealing with an application that managed to eat all the available memory within a few hours I found FastMM. And it sure was a great find.

What is FastMM?

FastMM is a memory manager replacement designed to be used with Delphi and C++ Builder. It is an Open Source project developed by Pierre Le Riche in South Africa.

Starting with Delphi 2006 FastMM replaced the Borland memory manager. Unfortunately, Delphi only ships with a subset of FastMM. Most of the useful debugging reporting that can be done with FastMM has been stripped from the shipping version of Delphi, RAD Studio and BDS.

But fear not! It is very simple to replace the stripped down version of FastMM with the full version. All you have to do is follow the directions outlined below. I have also included a step to install the FastMM4 Options Interface program. That program is a very friendly way of configuring the options contained in the file FastMM4Options.inc.

How to install FastMM

Download the latest FastMM source code from sourceforge.net or GitHub
Copy the content of the downloaded zip file to a folder on your computer.
In Delphi add a path in Tools>Options>Library – Win32 Library Path to the FastMM folder that contains the unit FastMM4.pas.
Copy the file FastMM_FullDebugMode.dll from the folder FastMM\FullDebugMode DLL\Precompiled to the Delphi install folder. For example in Delphi 2007 – C:\Program Files\CodeGear\RAD Studio\5.0\bin or in the Delphi XE install folder – C:\Program Files\Embarcadero\RAD Studio\8.0\bin
Optionally one can download and install the FastMM4 Options Interface program from JED software’s web site at jedqc
Configuring FastMM

Once you have properly installed FastMM4 you will be able to detect any memory leaks and attempts to use freed memory. But before we do that let’s take a look at what we have just installed.

In the FastMM folder you will find the file FastMM4Options.inc. This is the file that controls how FastMM behaves. Each option is very well documented and it is how you set the default behavior of FastMM. One can manually edit this file or, optionally, use the FastMM4 Options Interface.


Let’s take a quick look to this file. There are eight different sections in this file.

1 – Miscellaneous Options

This section contain general settings to control memory alignment, use of fastMove library, multithreaded behavior and debug only when running the ID

2 – Debugging Options

This section contains defines that control the debugging behavior of FastMM such as logging errors to a log file, dumping of memory along with an error, stack traces and more

3 – Memory Leak Reporting

This section controls the reporting of memory leaks, how to deal with expected memory leaks and the presence of the IDE or debug info to report errors.

4 – Instruction Set Options

This sections deals with using MMX instructions and this option currently only affects the variable size move routines.

5 – Memory Manager Sharing Options

This section allows sharing of the memory manager between a main application and DLLs.

6 – Option Grouping

Allows you to group a set of options for the release version and the debug version of your applications. So you can have the memory manager report issues when your application has been compiled for debugging and quietly ignore memory errors when compiled for release.

7 – Compilation Options For borlndmm.dll

If you’re compiling the replacement borlndmm.dll, set the defines in this section for the kind of DLL you require.

8 – Patch BCB Terminate

To enable the patching for BCB to make uninstallation and leak reporting.

What if I don’t want to mess with FastMM4Options.inc file?

Of course, you don’t have to edit the file manually. You can use FastMM4 Options Interface. However, you will not have access to the compilations options for debug and release version of your programs. Nevertheless, it is a very user friendly straightforward way of making changes to the default behavior of your application.

Switches are grouped in different tabs and for each option an detailed explanation (from FastMM4Options.inc) is displayed on the right pane.

Once you start the program you need to load the appropriate Option file, make the desired changes. Save the changes and rebuild your application.

Preparing and compiling projects in Delphi

There are a few simple steps to prepare your existing projects to use the full version of FastMM in a useful way.

You can control how FastMM behaves in two ways:
By making changes to Option Grouping in the FastMM4Options.inc so you can define different FastMM behaviors for your release version and debug version.
Or by using a conditional IFDEF statement to use the complete library on the debug version and ship the Delphi supplied library in the release version. To accomplish this, in Delphi open a project and add the unit FastMM4 as the first unit in the uses clause of the .dpr file.

uses
{$IFDEF DEBUG}
FastMM4,
{$ENDIF}
//DB,

Optionally, set FatsMM4 debug options using the FastMM4 Options Interface program. Make sure to build your program every time you make changes to any FastMM4 options.
In order for certain debug features of FastMM4 to work you must make sure that certain debug switches are turned on. The following is a list of recommended switches:
In the Compiler options set the following options
Debug Information
Reference Info
Use Debug DCUs
In the Linker options make sure that oneof the following options is set
TD32 Debug info
Map file
After you run the application a log of the memory manager can be found in the same folder where the application ran. The log file is named Leaks_MemoryManager_EventLog.txt.
If your project includes EXEs and DLLs you also need to define ShareMM, ShareMMIfLibrary and AttemptToUseSharedMM using the FastMM4 Options Interface program and add FastMM4.pas to the top of the uses section of the .dpr for both the main application and the DLL and follow the directions outlined in item 3. This will allow FastMM to report memory leaks across EXEs and DLLs.
What’s next?

That’s it! Now you are ready to detect memory errors like never before. Fire up your IDE and start plugging those leaks!

Monday 5 December 2016

1.6 Locking vs. Messaging

I believe that locking is evil. It leads to slow code and deadlocks and is one of the main reasons for almost-working multithreaded code (especially when you use shared data and forget to lock it up). Because of that, OmniThreadLibrary tries to move as much away from the shared data approach as possible. Cooperation between threads is rather achieved with messaging.
If we compare shared data approach with messaging, both have good and bad sides. On the good side, shared data approach is fast because it doesn’t move data around and is less memory intensive as the data is kept only in one copy. On the bad side, locking must be used to access data which leads to bad scaling (slowdowns when many threads are accessing the data), deadlocks and livelocks.
The situation is almost reversed for the messaging. There’s no shared data so no locking, which makes the program faster, more scalable and less prone to fall in the deadlocking trap. (Livelocking is still possible, though.) On the bad side, it uses more memory, requires copying data around (which may be a problem if shared data is large) and may lead to complicated and hard to understand algorithms.
OmniThreadLibrary uses custom lock-free structures to transfer data between the task and its owner (or directly between two tasks). The system is tuned for high data rates and can transfer more than million messages per second. However, in some situations shared data approach is necessary and that’s why OmniThreadLibrary adds significant support for synchronisation.


Lock-free (or microlocked) structures in OmniThreadLibrary encompass:
  • bounded (size-limited) stack
  • bounded (size-limited) queue
  • message queue
  • dynamic (growing) queue
  • blocking collection
OmniThreadLibrary automatically inserts two bounded queues between the task owner (IOmniTaskControl) and the task (IOmniTask) so that the messages can flow in both directions.

1.7 TOmniValue

TOmniValue (part of the OtlCommon unit) is data type which is central to the whole OmniThreadLibrary. It is used in all parts of the code (for example in a communication subsystem) when type of the data that is to be stored/passed around is not known in advance.
It is implemeted as a smart record (a record with functions and operators) which functions similary to a Variant or TValue but is faster. It can store following data types:
  • simple values (byte, integer, char, double, …)
  • strings (Ansi, Unicode)
  • Variant
  • objects
  • interfaces
  • records (in D2009 and newer)
In all cases ownership of reference-counted data types (strings, interfaces) is managed correctly so no memory leaks can occur when such type is stored in a TOmniValue variable.


The TOmniValue type is too large to be shown in one piece so I’ll show various parts of its interface throughout this chapter.

1.7.1 Data Access

The content of a TOmniValue record can be accessed in many ways, the simplest (and in most cases the most useful) being through the AsXXX properties.
property AsAnsiString: AnsiString;
property AsBoolean: boolean;
property AsCardinal: cardinal;
property AsDouble: Double;
property AsDateTime: TDateTime;
property AsException: Exception;
property AsExtended: Extended;
property AsInt64: int64 read;
property AsInteger: integer;
property AsInterface: IInterface;
property AsObject: TObject;
property AsOwnedObject: TObject;
property AsPointer: pointer;
property AsString: string;
property AsVariant: Variant;
property AsWideString: WideString;

Exceptions can be stored through the AsObject property, but there’s also a special support for Exception data type with its own data access property AsException. It is extensively used in the Pipeline high-level abstraction.

While the setters for those properties are pretty straightforward, getters all have a special logic built in which tries to convert data from any reasonable source type to the requested type. If that cannot be done, an exception is raised.

For example, getter for the AsString property is called CastToString and in turn calls TryCastToString, which is in turn a public function of TOmniValue.
function TOmniValue.CastToString: string;
begin
if not TryCastToString(Result) then
raise Exception.Create('TOmniValue cannot be converted to string');
end;
function TOmniValue.TryCastToString(var value: string): boolean;
 begin
 Result := true;
   case ovType of
     ovtNull:       value := '';
     ovtBoolean:    value := BoolToStr(AsBoolean, true);
     ovtInteger:    value := IntToStr(ovData);
     ovtDouble,
     ovtDateTime,
     ovtExtended:   value := FloatToStr(AsExtended);
     ovtAnsiString: value := string((ovIntf as IOmniAnsiStringData).Value);
     ovtString:     value := (ovIntf as IOmniStringData).Value;
     ovtWideString: value := (ovIntf as IOmniWideStringData).Value;
     ovtVariant:    value := string(AsVariant);
     else Result := false;
   end;
 end;

When you don’t know the data type stored in a TOmniValue variable and you don’t want to raise an exception if compatible data is not available, you can use the TryCastToXXX family of functions directly.
function  TryCastToAnsiString(var value: AnsiString): boolean;
 function  TryCastToBoolean(var value: boolean): boolean;
 function  TryCastToCardinal(var value: cardinal): boolean;
 function  TryCastToDouble(var value: Double): boolean;
 function  TryCastToDateTime(var value: TDateTime): boolean;
 function  TryCastToException(var value: Exception): boolean;
 function  TryCastToExtended(var value: Extended): boolean;
 function  TryCastToInt64(var value: int64): boolean;
 function  TryCastToInteger(var value: integer): boolean;
 function  TryCastToInterface(var value: IInterface): boolean;
 function  TryCastToObject(var value: TObject): boolean;
 function  TryCastToPointer(var value: pointer): boolean;
 function  TryCastToString(var value: string): boolean;
 function  TryCastToVariant(var value: Variant): boolean;
 function  TryCastToWideString(var value: WideString): boolean;

Alternatively, you can use CastToXXXDef functions which return a default value if current value of the TOmniValue cannot be converted into required data type.
function  CastToAnsiStringDef(const defValue: AnsiString): AnsiString;
 function  CastToBooleanDef(defValue: boolean): boolean;
 function  CastToCardinalDef(defValue: cardinal): cardinal;
 function  CastToDoubleDef(defValue: Double): Double;
 function  CastToDateTimeDef(defValue: TDateTime): TDateTime;
 function  CastToExceptionDef(defValue: Exception): 
 Exception;
 function  CastToExtendedDef(defValue: Extended): Extended;
 function  CastToInt64Def(defValue: int64): int64;
 function  CastToIntegerDef(defValue: integer): integer;
 function  CastToInterfaceDef(const defValue: IInterface): IInterface;
 function  CastToObjectDef(defValue: TObject): TObject;
 function  CastToPointerDef(defValue: pointer): pointer;
 function  CastToStringDef(const defValue: string): string;
 function  CastToVariantDef(defValue: Variant): Variant;
 function  CastToWideStringDef(defValue: WideString): WideString;

They are all implemented in the same value, similar to the CastToObjectDef below.
function TOmniValue.CastToObjectDef(defValue: TObject): TObject;
 begin
   if not TryCastToObject(Result) then
     Result := defValue;
 end;

1.5 Tasks vs. Threads - OmniThreadLibrary

1.5 Tasks vs. Threads

In OmniThreadLibrary you don’t create threads but tasks. A task can be executed in a new thread or in an existing thread, taken from the thread pool.
A task is created using CreateTask function, which takes as a parameter a global procedure, a method, an instance of a TOmniWorker class (or, usually, a descendant of that class) or an anonymous method (in Delphi 2009 and newer). CreateTaskreturns an IOmniTaskControl interface, which can be used to control the task. A task is always created in suspended state and you have to call Run to activate it (or Schedule to run it in a thread pool).



















The task has access to the IOmniTask interface and can use it to communicate with the owner (the part of the program that started the task). Both interfaces are explained in full detail in chapter Low-level multithreading.
The distinction between the task and the thread can be summarized in few simple words.

Task is part of code that has to be executed.
Thread is the execution environment.
You take care of the task, OmniThreadLibrary takes care of the thread.







Introduction to OmniThreadLibrary [2]

1.3 Installation

  1. Download the last stable edition (download link is available at the OmniThreadLibrary site, or download the latest state from the repository. Typically, it is safe to follow the repository trunk as only tested code is committed. [Saying that, I have to admit that from time to time a bug or two do creep in but they are promptly exterminated].
  2. If you have downloaded the last stable edition, unpack it to a folder.
  3. Add the folder where you [unpacked last stable edition/checked out the SVN trunk] to the Delphi’s Library path. Also add the src subfolder to the Library path. In case you are already using units from my GpDelphiUnits
  4. Add necessary units to the uses statement and start using the library! 
If you have XE8 or newer, you can download and install OmniThreadLibrary with the built-in GetIt! package manager. In that case you don’t have to manually add OmniThreadLibrary paths and you can also skip the next step (Installing Design Package). Both will be done automatically by the GetIt!

1.3.1 Installing Design Package

OmniThreadLibrary includes one design-time component (TOmniEventMonitor) which may be used to receive messages sent from the background tasks and to monitor thread creation/destruction. It is used in some of the demo applications.
To compile and install the package containing this component, follow these steps:
  • From Delphi, open packages subfolder of the OmniThreadLibrary installation and select file OmniThreadLibraryPackages{VER}.groupproj (where {VER} indicates the version of the Delphi you’re using; at the moment of writing {VER} could be 200720092010XEXE2XE3XE4XE5XE6XE7, or XE8).
  • In the Project Manager window you’ll find two projects – OmniThreadLibraryRuntime{VER}.bpl and OmniThreadLibraryDesigntime{VER}.bpl. If the Project Manager window is not visible, select ViewProject Manager from the menu.


  • Right-click on the OmniThreadLibraryRuntime{VER}.bpland select Build from the pop-up menu.
  • Right-click on the OmniThreadLibraryDesigntime{VER}.bpl and select Buildfrom the pop-up menu.
  • Right-click again on the OmniThreadLibraryDesigntime{VER}.bpl and select Installfrom the pop-up menu.
  • Delphi will report that the TOmniEventMonitor component was installed.










  • Close the project group with FileClose All. If Delphi asks you whether to save modified files, choose No.
You should repeat these steps whenever the OmniThreadLibrary installation is updated.

1.4 Why Use OmniThreadLibrary?

OmniThreadLibrary approaches the threading problem from a different perspective than TThread. While the Delphi’s native approach is oriented towards creating and managing threads on a very low level, the main design guideline behind OmniThreadLibrary is: “Enable the programmer to work with threads in as fluent way as possible.” The code should ideally relieve you from all burdens commonly associated with multithreading.
OmniThreadLibrary was designed to become a “VCL for multithreading” – a library that will make typical multithreading tasks really simple but still allow you to dig deeper and mess with the multithreading code at the operating system level. While still allowing this low-level tinkering, OmniThreadLibrary allows you to work on a higher level of abstraction most of the time.
There are two important points of distinction between TThread and OmniThreadLibrary, both explained further in this chapter. One is that OmniThreadLibrary focuses on tasks, not threads and another is that in OmniThreadLibrary messaging tries to replace locking whenever possible.
By moving most of the critical multithreaded code into reusable components (classes and high-level abstractions), OmniThreadLibrary allows you to write better multithreaded code faster.

Introduction to OmniThreadLibrary

OmniThreadLibrary is a multithreading library for Delphi, written mostly by the author of this book (see Credits for full list of contributors). OmniThreadLibrary can be roughly divided into three parts. Firstly, there are building blocks that can be used either with the OmniThreadLibrary threading helpers or with any other threading approach (f.i. with Delphi’s TThread or with AsyncCalls). Most of these building blocks are described in chapter Miscellaneous, while some parts are covered elsewhere in the book (Lock-free CollectionsBlocking collectionSynchronization).
Secondly, OmniThreadLibrary brings low-level multithreadingframework, which can be thought of as a scaffolding that wraps the TThread class. This framework simplifies passing messages to and from the background threads, starting background tasks, using thread pools and more.
Thirdly, OmniThreadLibrary introduces high-level multithreadingconcept. High-level framework contains multiple pre-packaged solutions (so-called abstractions; f.i. parallel for, pipeline, fork/join …) which can be used in your code. The idea is that the user should just choose appropriate abstraction and write the worker code, while the OmniThreadLibrary provides the framework that implements the tricky multithreaded parts, takes care of synchronisation and so on.

1.1 Requirements

OmniThreadLibrary requires at least Delphi 2007 and doesn’t work with FreePascal. The reason for this is that most parts of OmniThreadLibrary use language constructs that are not yet supported by the FreePascal compiler.
High-level multithreading framework requires at least Delphi 2009.
OmniThreadLibrary currently only targets Windows installation. Both 32-bit and 64-bit platform are supported.

1.2 License

OmniThreadLibrary is an open-sourced library with the OpenBSD license.
This software is distributed under the BSD license.
Copyright (c) 2015, Primoz Gabrijelcic
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
  • Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
  • Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
  • The name of the Primoz Gabrijelcic may not be used to endorse or promote products derived from this software without specific prior written permission.
In short, this means that:
  1. You can use the library in any project, free, open source or commercial, without having to mention my name or the name of the library anywhere in your project, documentation or on the web site.
  2. You can change the source for your own use. You can also put a modified version on the web, but you must not remove my name or the license from the source code.
  3. I’m not guilty if the software blows in your face. Remember, you got OmniThreadLibrary for free.

3.4 Task Controller Needs an Owner

Task Controller Needs an Owner
The IOmniTaskController interface returned from the CreateTask must always be stored in a variable/field with a scope that exceeds the lifetime of the background task. In other words, don’t store a long-term background task interface in a local variable.

The simplest example of the wrong approach can be written in one line:
CreateTask(MyWorker).Run;

This code looks fine, but it doesn’t work. In this case, the IOmniTaskController interface is stored in a hidden temporary variable which is destroyed at the end of the current method. This then causes the task controller to be destroyed which in turn causes the background task to be destroyed. Running this code would therefore just create and then destroy the task.

A common solution is to just store the interface in some field.
FTaskControl := CreateTask(MyWorker).Run;

When you don’t need background worker anymore, you should terminate the task and free the task controller.
FTaskControl.Terminate;
FTaskControl := nil;

Another solution is to provide the task with an implicit owner. You can, for example, use the event monitor to monitor tasks lifetime or messages sent from the task and that will make the task owned by the monitor. The following code is therefore valid:
CreateTask(MyWorker).MonitorWith(eventMonitor).Run;

Yet another possibility is to call the Unobserved) before the Run. This method makes the task being observed by an internal monitor.
CreateTask(MyWorker).Unobserved.Run;

When you use a thread pool to run a task, the thread pool acts as a task owner so there’s no need for an additional explicit owner.
procedure Beep(const task: IOmniTask);
begin
   MessageBeep(MB_ICONEXCLAMATION);
 end;
 
 CreateTask(Beep, 'Beep').Schedule;

Low-level Multithreading with OmniThreadLibrary

The low-level OmniThreadLibrary layer focuses on the task concept. In most aspects this is similar to the Delphi’s TThread approach except that OmniThreadLibrary focuses on the code (a.k.a. task) and interaction with the code while the Delphi focuses on the operating system primitive required for executing additional threads (TThread).

A task is created using the CreateTask function, which takes as a parameter a global procedure, a method, an instance of the TOmniWorker class (or, usually, a descendant of that class) or an anonymous procedure (in Delphi 2009 and newer). CreateTask will also accept an optional second parameter, a task name, which will be displayed in the Delphi’s Thread view on the thread running the task.

type
 TOmniTaskProcedure = procedure(const task: IOmniTask);
  TOmniTaskMethod = procedure(const task: IOmniTask) of object;
  TOmniTaskDelegate = reference to procedure(const task: IOmniTask);

function CreateTask(worker: TOmniTaskProcedure; const taskName: string = ''): 
  IOmniTaskControl; overload;
function CreateTask(worker: TOmniTaskMethod; const taskName: string = ''): 
  IOmniTaskControl; overload;
function CreateTask(worker: TOmniTaskDelegate; const taskName: string = ''): 
  IOmniTaskControl; overload;
function CreateTask(const worker: IOmniWorker; const taskName: string = ''): 
  IOmniTaskControl; overload; 
CreateTask returns a feature-full interface IOmniTaskControl which we will explore in this chapter. The most important function in this interface, Run, will create a new thread and start your task in it.

Low-level For the Impatient
The following code represents the simplest possible low-level OmniThreadLibrary example. It executes the Beep function in a background thread. The Beep function merely beeps and exits. By exiting from the task function, the Windows thread running the task is also terminated.
procedure TfrmTestSimple.Beep(const task: IOmniTask);
begin
  //Executed in a background thread
  MessageBeep(MB_ICONEXCLAMATION);
end;

CreateTask(Beep, 'Beep').Run;
Another way to start a task is to call a Schedule function which starts it in a thread allocated from a thread pool. This is covered in the Thread Pooling chapter.

Four ways to create a task
Let’s examine all four ways of creating a task. The simplest possible way (demoed in application 2_TwoWayHello) is to pass a name of a global procedure to the CreateTask. This global procedure must consume one parameter of type IOmniTask .
procedure RunHelloWorld(const task: IOmniTask);
begin
  //
end;

CreateTask(RunHelloWorld, 'HelloWorld').Run;
A variation on the theme is passing a name of a method to the CreateTask. This approach is used in the demo application 1_HelloWorld. The interesting point here is that you can declare this method in the same class from which the CreateTask is called. That way you can access all class fields and methods from the threaded code. Just keep in mind that you’ll be doing this from another thread so make sure you know what you’re doing!
procedure TfrmTestHelloWorld.RunHelloWorld(const task: IOmniTask);
begin
  //
end;

procedure TfrmTestHelloWorld.StartTask;
begin
  CreateTask(RunHelloWorld, 'HelloWorld').Run;
end;
In Delphi 2009 and newer you can also write the task code as an anonymous function.
CreateTask(
procedure (const task: IOmniTask)
begin
  //
end,
'HellowWorld').Run;
For all except the simplest tasks, you’ll use the fourth approach as it will give you access to the true OmniThreadLibrary power (namely internal wait loop and message dispatching). To use it, you have to create a worker object deriving from the TOmniWorker class.
type
  THelloWorker = class(TOmniWorker)
  end;

procedure TfrmTestTwoWayHello.actStartHelloExecute(Sender: TObject);
begin
  FHelloTask :=
    CreateTask(THelloWorker.Create(), 'Hello').
    Run;
end;
IOmniTaskControl and IOmniTask Interfaces
When you create a low-level task, OmniThreadLibrary returns a task controller interface IOmniTaskControl. This interface, which is defined in the OtlTaskControl unit, can be used to control the task from the owner’s side. The task code, on the other hand, has access to another interface, IOmniTask (defined in the OtlTask unit), which can be used to communicate with the owner and manipulate the task itself. A picture in the Tasks vs. Threads chapter shows the relationship between those interfaces.

This chapter deals mainly with these two interfaces. For the reference reasons, the IOmniTaskControl is reprinted here in full. In the rest of the chapter I’ll just show relevant interface parts.

The IOmniTask interface is described at the end of this chapter.
type
IOmniTaskControl = interface 
 function  Alertable: IOmniTaskControl;
 function  CancelWith(const token: IOmniCancellationToken): IOmniTaskControl;
 function  ChainTo(const task: IOmniTaskControl;
   ignoreErrors: boolean = false): IOmniTaskControl;
 function  ClearTimer(timerID: integer): IOmniTaskControl;
 function  DetachException: Exception;
 function  Enforced(forceExecution: boolean = true): IOmniTaskControl;
 function  GetFatalException: Exception;
 function  GetParam: TOmniValueContainer;
 function  Invoke(const msgMethod: pointer): IOmniTaskControl; overload;
 function  Invoke(const msgMethod: pointer; 
   msgData: array of const): IOmniTaskControl; overload;
 function  Invoke(const msgMethod: pointer; 
   msgData: TOmniValue): IOmniTaskControl; overload;
 function  Invoke(const msgName: string): IOmniTaskControl; overload;
 function  Invoke(const msgName: string; 
   msgData: array of const): IOmniTaskControl; overload;
 function  Invoke(const msgName: string; 
   msgData: TOmniValue): IOmniTaskControl; overload;
 function  Invoke(remoteFunc: TOmniTaskControlInvokeFunction):
   IOmniTaskControl; overload;
 function  Invoke(remoteFunc: TOmniTaskControlInvokeFunctionEx):
   IOmniTaskControl; overload;
 function  Join(const group: IOmniTaskGroup): IOmniTaskControl;
 function  Leave(const group: IOmniTaskGroup): IOmniTaskControl;
 function  MonitorWith(const monitor: IOmniTaskControlMonitor): 
   IOmniTaskControl;
 function  MsgWait(wakeMask: DWORD = QS_ALLEVENTS): IOmniTaskControl;
 function  OnMessage(eventDispatcher: TObject): IOmniTaskControl; overload;
function  OnMessage(eventHandler: TOmniTaskMessageEvent): IOmniTaskControl; overload;
function  OnMessage(msgID: word; eventHandler: TOmniTaskMessageEvent): 
  IOmniTaskControl; overload;
function  OnMessage(msgID: word; eventHandler: TOmniMessageExec): 
  IOmniTaskControl; overload;
function  OnMessage(eventHandler: TOmniOnMessageFunction): 
  IOmniTaskControl; overload;
function  OnMessage(msgID: word; eventHandler: TOmniOnMessageFunction):
  IOmniTaskControl; overload;
function  OnTerminated(eventHandler: TOmniOnTerminatedFunction):
  IOmniTaskControl; overload;
function  OnTerminated(eventHandler: TOmniOnTerminatedFunctionSimple): 
  IOmniTaskControl; overload;
function  OnTerminated(eventHandler: TOmniTaskTerminatedEvent): 
  IOmniTaskControl; overload;
function  RemoveMonitor: IOmniTaskControl;
function  Run: IOmniTaskControl;
function  Schedule(const threadPool: IOmniThreadPool = nil {default pool}):
  IOmniTaskControl;
function  SetMonitor(hWindow: THandle): IOmniTaskControl;
function  SetParameter(const paramName: string; 
  const paramValue: TOmniValue): IOmniTaskControl; overload;
function  SetParameter(const paramValue: TOmniValue): 
  IOmniTaskControl; overload;
function  SetParameters(const parameters: array of TOmniValue):
  IOmniTaskControl;
function  SetPriority(threadPriority: TOTLThreadPriority): IOmniTaskControl;
function  SetQueueSize(numMessages: integer): IOmniTaskControl;
function  SetTimer(timerID: integer; interval_ms: cardinal; 
  const timerMessage: TOmniMessageID): IOmniTaskControl; overload;
function  SetUserData(const idxData: TOmniValue; 
  const value: TOmniValue): IOmniTaskControl;
procedure Stop;
function  Terminate(maxWait_ms: cardinal = INFINITE): boolean; 
function  TerminateWhen(event: THandle): IOmniTaskControl; overload;
function  TerminateWhen(token: IOmniCancellationToken): 
  IOmniTaskControl; overload;
function  Unobserved: IOmniTaskControl;
function  WaitFor(maxWait_ms: cardinal): boolean;
function  WaitForInit: boolean;
function  WithCounter(const counter: IOmniCounter): IOmniTaskControl;
function  WithLock(const lock: TSynchroObject; 
  autoDestroyLock: boolean = true): IOmniTaskControl; overload;
 function  WithLock(const lock: IOmniCriticalSection): IOmniTaskControl; overload;
  property CancellationToken: IOmniCancellationToken 
    read GetCancellationToken;
  property Comm: IOmniCommunicationEndpoint read GetComm;
  property ExitCode: integer read GetExitCode;
  property ExitMessage: string read GetExitMessage;
  property FatalException: Exception read GetFatalException;
  property Lock: TSynchroObject read GetLock;
  property Name: string read GetName;
  property Param: TOmniValueContainer read GetParam;
  property UniqueID: int64 read GetUniqueID;
  property UserData[const idxData: TOmniValue]: TOmniValue 
    read GetUserDataVal write SetUserDataVal;
end;

Copied from: https://leanpub.com/omnithreadlibrary




Sunday 4 December 2016

Delphi Program Name,Process ID,Window Handle

// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(const APName: string): THandle;

// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(const APName: string): THandle;

// Get Window Handle By ProcessID
function GetHWndByPID(const hPID: THandle): THandle;

// Get ProcessID By Window Handle
function GetPIDByHWnd(const hWnd: THandle): THandle;

// Get Process Handle By Window Handle
function GetProcessHndByHWnd(const hWnd: THandle): THandle;

// Get Process Handle By Process ID
function GetProcessHndByPID(const hAPID: THandle): THandle; 


// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(const APName: string): THandle;
begin
   Result := GetHWndByPID(GetPIDByProgramName(APName));
end;

// Get Process Handle By Window Handle
function GetProcessHndByHWnd(const hWnd: THandle): THandle;
var
   PID: DWORD;
   AhProcess: THandle;
begin
   if hWnd <> 0 then
   begin
      GetWindowThreadProcessID(hWnd, @PID);
      AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, PID);
      Result := AhProcess;
      CloseHandle(AhProcess);
   end
   else
      Result := 0;
end;

// Get Process Handle By Process ID
function GetProcessHndByPID(const hAPID: THandle): THandle;
var
   AhProcess: THandle;
begin
   if hAPID <> 0 then
   begin
      AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, hAPID);
      Result := AhProcess;
      CloseHandle(AhProcess);
   end
   else
      Result := 0;
end;

// Get Window Handle By ProcessID
function GetPIDByHWnd(const hWnd: THandle): THandle;
var
   PID: DWORD;
begin
   if hWnd <> 0 then
   begin
      GetWindowThreadProcessID(hWnd, @PID);
      Result := PID;
   end
   else
      Result := 0;
end;

// Get Window Handle By ProcessID
function GetHWndByPID(const hPID: THandle): THandle;
type
   PEnumInfo = ^TEnumInfo;
   TEnumInfo = record
      ProcessID: DWORD;
      HWND: THandle;
   end;
   function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall;
   var
      PID: DWORD;
   begin
      GetWindowThreadProcessID(Wnd, @PID);
      Result := (PID <> EI.ProcessID) or
         (not IsWindowVisible(WND)) or
         (not IsWindowEnabled(WND));
      if not Result then EI.HWND := WND; //break on return FALSE
   end;
   
function FindMainWindow(PID: DWORD): DWORD;
   var
      EI: TEnumInfo;
   begin
      EI.ProcessID := PID;
      EI.HWND := 0;
      EnumWindows(@EnumWindowsProc, Integer(@EI));
      Result := EI.HWND;
   end;
begin
   if hPID <> 0 then
      Result := FindMainWindow(hPID)
   else
      Result := 0;
end;

// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(const APName: string): THandle;
var
   isFound: boolean;
   AHandle, AhProcess: THandle;
   ProcessEntry32: TProcessEntry32;
   APath: array[0..MAX_PATH] of char;
begin
   Result := 0;
   AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   try
      ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
      isFound := Process32First(AHandle, ProcessEntry32);
      while isFound do
      begin
         AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
            false, ProcessEntry32.th32ProcessID);
         GetModuleFileNameEx(AhProcess, 0, @APath[0], sizeof(APath));
         if (UpperCase(StrPas(APath)) = UpperCase(APName)) or
            (UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName)) then
         begin
            Result := ProcessEntry32.th32ProcessID;
            break;
         end;
         isFound := Process32Next(AHandle, ProcessEntry32);
         CloseHandle(AhProcess);
      end;
   finally
      CloseHandle(AHandle);
   end;
end;

// Activate a window by its handle
function AppActivate(WindowHandle: HWND): boolean; overload;
begin
   try
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
      result := SetForegroundWindow(WindowHandle);
   except
      on Exception do Result := false;
   end;
end;

Getting the parent process filename of a PID, using Delphi

uses
  Psapi,
  Windows,
  tlhelp32,
  SysUtils;
 
function GetParentProcessFileName(PID : DWORD): String;
var                              
  HandleSnapShot      : THandle;
  EntryParentProc     : TProcessEntry32;
  HandleParentProc    : THandle;
  ParentPID           : DWORD;
  ParentProcessFound  : Boolean;
  ParentProcPath      : PChar;
begin
  ParentProcessFound := False;
  HandleSnapShot     := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  GetMem(ParentProcPath, MAX_PATH);
  try
    if HandleSnapShot <> INVALID_HANDLE_VALUE then
    begin
      EntryParentProc.dwSize := SizeOf(EntryParentProc);
      if Process32First(HandleSnapShot, EntryParentProc) then
      begin
        repeat
          if EntryParentProc.th32ProcessID = PID then
          begin
            ParentPID  := EntryParentProc.th32ParentProcessID;
            HandleParentProc  := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ParentPID);
            ParentProcessFound:= HandleParentProc <> 0;
            if ParentProcessFound then
            begin
                GetModuleFileNameEx(HandleParentProc, 0, PChar(ParentProcPath), MAX_PATH);
                ParentProcPath := PChar(ParentProcPath);
                CloseHandle(HandleParentProc);
            end;
            break;
          end;
        until not Process32Next(HandleSnapShot, EntryParentProc);
      end;
      CloseHandle(HandleSnapShot);
    end;
 
    if ParentProcessFound then
      Result := ParentProcPath
    else
      Result := '';
  finally
      FreeMem(ParentProcPath);
  end;
end;

by : Rodrigo Ruz

Friday 2 December 2016

Wait for thread without freezing the application - Indy [example]

Use the TThread.OnTerminate event to know when the thread has finished:
type
  TSendThread = class(TThread)
  private
    http : TIdHTTP;
    Line: string;
    procedure AddLine;
  protected
    procedure Execute; override;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    URL : String;
    Method : String;
    property ReturnValue;
  end;

constructor TSendThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  http := TIdHTTP.Create;
end;

destructor TSendThread.Destroy;
begin
  http.Free;
  inherited;
end;

procedure TSendThread.Execute;
begin
  Line := http.Get(URL);
  Synchronize(AddLine);
  ReturnValue := 1;
end;

procedure TSendThread.AddLine;
begin
  Form1.Memo1.Lines.Add(Line);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  t : TSendThread;
begin
  t := TSendThread.Create;
  t.URL := 'http://www.url.com/';
  t.OnTerminate := ThreadTerminated;
  t.Start;
end;

procedure TForm1.ThreadTerminated(Sender: TObject);
begin
  ShowMessage(IntToStr(TSendThread(Sender).ReturnValue));
end;
If you want to use a loop to wait for the thread to finish, without blocking the UI, then you can do it like this:
constructor TSendThread.Create;
begin
  inherited Create(True);
  //FreeOnTerminate := True; // <-- remove this
  http := TIdHTTP.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  t : TSendThread;
  h : THandle;
begin
  t := TSendThread.Create;
  try
    t.URL := 'http://www.url.com/';
    t.Start;
    h := t.Handle;
    repeat
      case MsgWaitForMultipleObjects(1, h, 0, INFINITE, QS_ALLINPUT) of
        WAIT_OBJECT_0:   Break;
        WAIT_OBJECT_0+1: Application.ProcessMessages;
        WAIT_FAILED:     RaiseLastOSError;
      else
        Break;
      end;
    until False;
    ShowMessage(IntToStr(t.ReturnValue));
  finally
    t.Free;
  end;
end;

credit: Remy Lebeau - http://stackoverflow.com/

Thursday 1 December 2016

Create a Job object And terminate Child Process

How to gracefully handle when main.exe terminated, child.exe terminated also?
You need to use jobs. Main executable should create a job object, then you'll need to set JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE flag to your job object.
uses
  JobsApi;
//...
var
  jLimit: TJobObjectExtendedLimitInformation;

  hJob := CreateJobObject(nil, PChar('JobName');
  if hJob <> 0 then
  begin
    jLimit.BasicLimitInformation.LimitFlags := JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;
      SetInformationJobObject(hJob, JobObjectExtendedLimitInformation, @jLimit,
        SizeOf(TJobObjectExtendedLimitInformation));
  end; 
Then you need to execute another process with CreateProcess function where dwCreationFlags must be set to CREATE_BREAKAWAY_FROM_JOB. If this function succeeds call AssignProcessToJobObject.
function ExecuteProcess(const EXE : String; const AParams: string = ''; AJob: Boolean = True): THandle;
var
  SI : TStartupInfo;
  PI : TProcessInformation;
  AFlag: Cardinal;
begin
  Result := INVALID_HANDLE_VALUE;
  FillChar(SI,SizeOf(SI),0);
  SI.cb := SizeOf(SI);

  if AJob then
    AFlag := CREATE_BREAKAWAY_FROM_JOB
  else
    AFlag := 0;


  if CreateProcess(
     nil,
     PChar(EXE + ' ' + AParams),
     nil,
     nil,
     False,
     AFlag,
     nil,
     nil,
     SI,
     PI
     ) then
  begin
   { close thread handle }
    CloseHandle(PI.hThread);
    Result := PI.hProcess;
  end;
end;
//...
  hApp := ExecuteProcess('PathToExecutable');

  if hApp <> INVALID_HANDLE_VALUE then
  begin
     AssignProcessToJobObject(hJob, hApp);
  end;
When all of this done all the child processes will be automatically terminated even if the main executable has been killed. You can get the JobsApi unit here.

If you nee add some changes to be able user to set show window flags for child processes like SW_SHOW/SW_HIDE.

function ExecuteProcess(const EXE : String; const AParams: string = '';
  const nCmdShow: Integer = SW_SHOW; AJob: Boolean = True): THandle;
var
  SI : TStartupInfo;
  PI : TProcessInformation;
  AFlag: Cardinal;
begin
  Result := INVALID_HANDLE_VALUE;
  FillChar(SI,SizeOf(SI),0);
  SI.cb := SizeOf(SI);
  SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  SI.wShowWindow := nCmdShow;

  if AJob then
    AFlag := CREATE_BREAKAWAY_FROM_JOB
  else
    AFlag := 0;
........
Demo Project can be downloaded here.
Or For JobsApi Take a look here:
unit JobsApi;

interface

uses
  Windows;


type
  TJobObjectInfoClass   =   Cardinal;

  PJobObjectAssociateCompletionPort   =   ^TJobObjectAssociateCompletionPort;
  TJobObjectAssociateCompletionPort   =   Record
      CompletionKey     :   Pointer;
      CompletionPort   :   THandle;
  End;

  PJobObjectBasicLimitInformation   =   ^TJobObjectBasicLimitInformation;
  TJobObjectBasicLimitInformation   =  packed Record
      PerProcessUserTimeLimit   :   TLargeInteger;
      PerJobUserTimeLimit           :   TLargeInteger;
      LimitFlags                             :   DWORD;
      MinimumWorkingSetSize       :   DWORD;
      MaximumWorkingSetSize       :   DWORD;
      ActiveProcessLimit             :   DWORD;
      Affinity                                 :   DWORD;
      PriorityClass                       :   DWORD;
      SchedulingClass                   :   DWORD;
  End;

  PJobObjectBasicUIRestrictions   =   ^TJobObjectBasicUIRestrictions;
  TJobObjectBasicUIRestrictions   =   Record
      UIRestrictionsClass   :   DWORD;
  End;

  PJobObjectEndOfJobTimeInformation   =   ^TJobObjectEndOfJobTimeInformation;
  TJobObjectEndOfJobTimeInformation   =   Record
      EndOfJobTimeAction   :   DWORD;
  End;

  TIOCounters   =   Record   {   all   fields   should   be   actually   unsigned   int64 's   }
      ReadOperationCount     :   Int64;
      WriteOperationCount   :   Int64;
      OtherOperationCount   :   Int64;
      ReadTransferCount       :   Int64;
      WriteTransferCount     :   Int64;
      OtherTransferCount     :   Int64;
  End;

  PJobObjectExtendedLimitInformation   =   ^TJobObjectExtendedLimitInformation;
  TJobObjectExtendedLimitInformation   =   Record
      BasicLimitInformation   :   TJobObjectBasicLimitInformation;
      IoInfo                                 :   TIOCounters;
      ProcessMemoryLimit         :   DWORD;
      JobMemoryLimit                 :   DWORD;
      PeakProcessMemoryUsed   :   DWORD;
      PeakJobMemoryUsed           :   DWORD;
  End;

  PJobObjectSecurityLimitInformation   =   ^TJobObjectSecurityLimitInformation;
  TJobObjectSecurityLimitInformation   =   Record
      SecurityLimitFlags   :   DWORD;
      JobToken                       :   THandle;
      SidsToDisable             :   PTokenGroups;
      PrivilegesToDelete   :   PTokenPrivileges;
      RestrictedSids           :   PTokenGroups;
  End;

  PJobObjectBasicAccountingInformation   =   ^TJobObjectBasicAccountingInformation;
  TJobObjectBasicAccountingInformation   =   Record
      TotalUserTime                           :   TLargeInteger;
      TotalKernelTime                       :   TLargeInteger;
      ThisPeriodTotalUserTime       :   TLargeInteger;
      ThisPeriodTotalKernelTime   :   TLargeInteger;
      TotalPageFaultCount               :   DWORD;
      TotalProcesses                         :   DWORD;
      ActiveProcesses                       :   DWORD;
      TotalTerminatedProcesses     :   DWORD;
  End;

  PJobObjectBasicAndIOAccountingInformation   =   ^TJobObjectBasicAndIOAccountingInformation;
  TJobObjectBasicAndIOAccountingInformation   =   Record
      BasicInfo   :   TJobObjectBasicAccountingInformation;
      IoInfo         :   TIOCounters;
  End;

  PJobObjectBasicProcessIDList = ^TJobObjectBasicProcessIDList;
  TJobObjectBasicProcessIDList = Record
      NumberOfAssignedProcesses : DWORD;
      NumberOfProcessIdsInList : DWORD;
      ProcessIdList : Array[0..0] of ULONG;
  End;

const
  {$IFDEF UNICODE}
  AWSuffix = 'W';
  {$ELSE}
  AWSuffix = 'A';
  {$ENDIF UNICODE}

const
  {for TJobObjectInfoClass }
  JobObjectBasicAccountingInformation                   =   1;
  JobObjectBasicLimitInformation                             =   2;
  JobObjectBasicProcessIdList                                   =   3;
  JobObjectBasicUIRestrictions                                 =   4;
  JobObjectSecurityLimitInformation                       =   5;
  JobObjectEndOfJobTimeInformation                         =   6;
  JobObjectAssociateCompletionPortInformation   =   7;
  JobObjectBasicAndIoAccountingInformation         =   8;
  JobObjectExtendedLimitInformation                       =   9;
  MaxJobObjectInfoClass                                               =   10;


  JOB_OBJECT_ASSIGN_PROCESS = $0001;
  {$EXTERNALSYM JOB_OBJECT_ASSIGN_PROCESS}
  JOB_OBJECT_SET_ATTRIBUTES = $0002;
  {$EXTERNALSYM JOB_OBJECT_SET_ATTRIBUTES}
  JOB_OBJECT_QUERY = $0004;
  {$EXTERNALSYM JOB_OBJECT_QUERY}
  JOB_OBJECT_TERMINATE = $0008;
  {$EXTERNALSYM JOB_OBJECT_TERMINATE}
  JOB_OBJECT_SET_SECURITY_ATTRIBUTES = $0010;
  {$EXTERNALSYM JOB_OBJECT_SET_SECURITY_ATTRIBUTES}
  JOB_OBJECT_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1F ;
  {$EXTERNALSYM JOB_OBJECT_ALL_ACCESS}


  JOB_OBJECT_TERMINATE_AT_END_OF_JOB                     =   0;
  JOB_OBJECT_POST_AT_END_OF_JOB                               =   1;
  JOB_OBJECT_MSG_END_OF_JOB_TIME                             =   1;
  JOB_OBJECT_MSG_END_OF_PROCESS_TIME                     =   2;
  JOB_OBJECT_MSG_ACTIVE_PROCESS_LIMIT                   =   3;
  JOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO                     =   4;   {   where 's   5?   }
  JOB_OBJECT_MSG_NEW_PROCESS                                     =   6;
  JOB_OBJECT_MSG_EXIT_PROCESS                                   =   7;
  JOB_OBJECT_MSG_ABNORMAL_EXIT_PROCESS                 =   8;
  JOB_OBJECT_MSG_PROCESS_MEMORY_LIMIT                   =   9;
  JOB_OBJECT_MSG_JOB_MEMORY_LIMIT                           =   10;
  JOB_OBJECT_LIMIT_WORKINGSET                                   =   $00000001;
  JOB_OBJECT_LIMIT_PROCESS_TIME                               =   $00000002;
  JOB_OBJECT_LIMIT_JOB_TIME                                       =   $00000004;
  JOB_OBJECT_LIMIT_ACTIVE_PROCESS                           =   $00000008;
  JOB_OBJECT_LIMIT_AFFINITY                                       =   $00000010;
  JOB_OBJECT_LIMIT_PRIORITY_CLASS                           =   $00000020;
  JOB_OBJECT_LIMIT_PRESERVE_JOB_TIME                     =   $00000040;
  JOB_OBJECT_LIMIT_SCHEDULING_CLASS                       =   $00000080;
  JOB_OBJECT_LIMIT_RESERVED1                                     =   $00002000;
  JOB_OBJECT_LIMIT_RESERVED2                                     =   $00004000;
  JOB_OBJECT_LIMIT_RESERVED3                                     =   $00008000;
  JOB_OBJECT_LIMIT_RESERVED4                                     =   $00010000;
  JOB_OBJECT_LIMIT_RESERVED5                                     =   $00020000;
  JOB_OBJECT_LIMIT_RESERVED6                                     =   $00040000;
  JOB_OBJECT_LIMIT_VALID_FLAGS                                 =   $0007FFFF;
  JOB_OBJECT_BASIC_LIMIT_VALID_FLAGS                     =   $000000FF;
  JOB_OBJECT_EXTENDED_LIMIT_VALID_FLAGS               =   $00001FFF;
  JOB_OBJECT_RESERVED_LIMIT_VALID_FLAGS               =   $0007FFFF;
  JOB_OBJECT_UILIMIT_NONE                                           =   $00000000;
  JOB_OBJECT_UILIMIT_HANDLES                                     =   $00000001;
  JOB_OBJECT_UILIMIT_READCLIPBOARD                         =   $00000002;
  JOB_OBJECT_UILIMIT_WRITECLIPBOARD                       =   $00000004;
  JOB_OBJECT_UILIMIT_SYSTEMPARAMETERS                   =   $00000008;
  JOB_OBJECT_UILIMIT_DISPLAYSETTINGS                     =   $00000010;
  JOB_OBJECT_UILIMIT_GLOBALATOMS                             =   $00000020;
  JOB_OBJECT_UILIMIT_DESKTOP                                     =   $00000040;
  JOB_OBJECT_UILIMIT_EXITWINDOWS                             =   $00000080;
  JOB_OBJECT_UILIMIT_ALL                                             =   $000000FF;
  JOB_OBJECT_UI_VALID_FLAGS                                       =   $000000FF;
  JOB_OBJECT_SECURITY_NO_ADMIN                                 =   $00000001;
  JOB_OBJECT_SECURITY_RESTRICTED_TOKEN                 =   $00000002;
  JOB_OBJECT_SECURITY_ONLY_TOKEN                             =   $00000004;
  JOB_OBJECT_SECURITY_FILTER_TOKENS                       =   $00000008;
  JOB_OBJECT_SECURITY_VALID_FLAGS                           =   $0000000F;
  CREATE_BREAKAWAY_FROM_JOB =  $01000000;
//
// Extended Limits
//

  JOB_OBJECT_LIMIT_PROCESS_MEMORY = $00000100;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_PROCESS_MEMORY}
  JOB_OBJECT_LIMIT_JOB_MEMORY = $00000200;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_JOB_MEMORY}
  JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION = $00000400;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION}
  JOB_OBJECT_LIMIT_BREAKAWAY_OK = $00000800;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_BREAKAWAY_OK}
  JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK = $00001000;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK}
  JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE = $00002000;
  {$EXTERNALSYM JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE}


function CreateJobObjectA(lpJobAttributes: PSecurityAttributes; lpName: LPCSTR): THANDLE; stdcall;
{$EXTERNALSYM CreateJobObjectA}
function CreateJobObjectW(lpJobAttributes: PSecurityAttributes; lpName: LPCWSTR): THANDLE; stdcall;
{$EXTERNALSYM CreateJobObjectW}
function CreateJobObject(lpJobAttributes: PSecurityAttributes; lpName: LPCTSTR): THANDLE; stdcall;
{$EXTERNALSYM CreateJobObject}

function OpenJobObjectA(dwDesiredAccess: DWORD; bInheritHandle: BOOL; lpName: LPCSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObjectA}
function OpenJobObjectW(dwDesiredAccess: DWORD; bInheritHandle: BOOL; lpName: LPCWSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObjectW}
function OpenJobObject(dwDesiredAccess: DWORD; bInheritHandle: BOOL; lpName: LPCTSTR): THANDLE; stdcall;
{$EXTERNALSYM OpenJobObject}

function AssignProcessToJobObject(hJob, hProcess: THANDLE): BOOL; stdcall;
{$EXTERNALSYM AssignProcessToJobObject}

function TerminateJobObject(hJob: THANDLE; uExitCode: UINT): BOOL; stdcall;
{$EXTERNALSYM TerminateJobObject}

function IsProcessInJob(ProcessHandle, JobHandle: THANDLE; var Result_: BOOL): BOOL; stdcall;
{$EXTERNALSYM IsProcessInJob}

Function QueryInformationJobObject(hJob : THandle;
                        JobObjectInformationClass : TJobObjectInfoClass;
                        lpJobObjectInformation : Pointer;
                        cbJobObjectInformationLength : DWORD;
                        lpReturnLength : PDWORD) : Bool; StdCall;
                        External Kernel32 Name 'QueryInformationJobObject';

Function SetInformationJobObject(hJob : THandle;
                        JobObjectInformationClass : TJobObjectInfoClass;
                        lpJobObjectInformation : Pointer;
                        cbJobObjectInformationLength : DWORD): BOOL; StdCall;
                        External Kernel32 Name 'SetInformationJobObject';

function CreateJobObjectA; external kernel32 name 'CreateJobObjectA';
function CreateJobObjectW; external kernel32 name 'CreateJobObjectW';
function CreateJobObject; external kernel32 name 'CreateJobObject' + AWSuffix;
function OpenJobObjectA; external kernel32 name 'OpenJobObjectA';
function OpenJobObjectW; external kernel32 name 'OpenJobObjectW';
function OpenJobObject; external kernel32 name 'OpenJobObject' + AWSuffix;
function AssignProcessToJobObject; external kernel32 name 'AssignProcessToJobObject';
function TerminateJobObject; external kernel32 name 'TerminateJobObject';
function IsProcessInJob; external kernel32 name 'IsProcessInJob';

implementation

end.

All credits go to Linas, - StackOverFlaw, the original creator

Run an application and get the handle to its window

Sometimes, when we start an application programmatically, it is useful to have a handle to it's window. The process of how to do this is described below.
1. create a new unit utils.pas:

unit utils;

interface

uses
Controls, Graphics, StdCtrls, ExtCtrls, ComCtrls, Buttons, Dialogs, Classes,
SysUtils, Windows, ShellApi, Forms;

procedure CloseMessage (process_id : Cardinal);

// get proc id
function RunCommandEx (const Cmd, Params: String) : Cardinal;

// get handle
function ExecApplication(APPName, CmdLine: String; out proc_id : Cardinal): Cardinal;

// for use with ExecApplication
function GetHandles(ThreadID: Cardinal): Cardinal;

var
WindowList: TList;

function GetWindow (Handle: Cardinal; LParam: longint): bool; stdcall;

implementation

function GetWindow (Handle: Cardinal; LParam: longint): bool; stdcall;
begin
    Result := true;
    WindowList.Add (Pointer (Handle));
end;

function ExecApplication(APPName, CmdLine: String; out proc_id : Cardinal): Cardinal;
var
    StartInfo: TStartupInfo;
    ProcInfo: TProcessInformation;
    process_id : Cardinal;
begin
    FillChar(StartInfo, SizeOf(StartInfo), 0);
    StartInfo.cb:=SizeOf(StartInfo);
    StartInfo.dwFlags:=STARTF_USESHOWWINDOW;
    StartInfo.wShowWindow:=SW_Show;
    if AppName <> '' then
    CreateProcess(PChar(APPName), PChar(CmdLine), nil, nil, False, 0, nil, nil,
        StartInfo, ProcInfo);
    Sleep(500);
    process_id := ProcInfo.dwProcessId;
    proc_id := ProcInfo.hProcess;
    Result := GetHandles(process_id);
    // CloseHandle (ProcInfo.hProcess);
    CloseHandle (ProcInfo.hThread );
end;

function GetHandles(ThreadID: Cardinal): Cardinal;
var
    i: integer;
    hnd : Cardinal;
    cpid : DWord;
begin
    Result:=0;
    WindowList := TList.Create;
    EnumWindows (@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
    begin
        hnd := HWND (WindowList [i]);
        GetWindowThreadProcessID (hnd, @cpid);
        if ThreadID = CPID then
        begin
            Result := hnd;
            Exit;
        end;
    end;
    WindowList.Free;
end;

procedure CloseMessage (process_id : Cardinal);
var
    StatusCode : Cardinal;
begin
    if process_id > 0 then
    begin
        if GetExitCodeProcess (process_id, StatusCode) then
        begin
            if StatusCode = STILL_ACTIVE then
                TerminateProcess (process_id, StatusCode);
            CloseHandle (process_id);
        end;
    end;
end;

function RunCommandEx (const Cmd, Params: String) : Cardinal;
var
    SEI: TShellExecuteInfo;

begin
    result := 0;

    //Fill record with zero byte values
    FillChar(SEI, SizeOf(SEI), 0);

    // Set mandatory record field
    SEI.cbSize := SizeOf(SEI);

    // Ask for an open process handle
    SEI.fMask := see_Mask_NoCloseProcess;

    // Tell API which window any error dialogs should be modal to
    SEI.Wnd := Application.Handle;

    //Set up command line
    SEI.lpFile := PChar(Cmd);

    if Length (Params) > 0 then
    SEI.lpParameters := PChar(Params);

    SEI.nShow := sw_ShowNormal;

    // Try and launch child process. Raise exception on failure
    if not ShellExecuteEx(@SEI) then
        Abort;

    // Wait until process has started its main message loop
    WaitForInputIdle(SEI.hProcess, Infinite);

    result := SEI.hProcess;
end;

end.
2. Create Window Handle
Now lets get back to the main form and create two global variables,
windows_handle and proc_id, and reference utils.pas:
type
TForm1 = class(TForm)

...

private
{ Private declarations }

public
{ Public declarations }
end;

var
    Form1: TForm1;
    window_handle : cardinal;
    proc_id : cardinal;

implementation

{$R *.dfm}

uses
    utils;
3. Use in Application
The application is ran as following:
procedure TForm1.cmdRunApplicationClick(Sender: TObject);
var
    app_name : string;
    command_line : string;
    StatusCode : Cardinal;

begin

    if proc_id > 0 then
        if GetExitCodeProcess (proc_id, StatusCode) then
            if StatusCode = STILL_ACTIVE then
            begin
                MessageDlg ('Application is already loaded', mtWarning, [mbOk], 0);
                exit;
            end;

    app_name := 'C:\WINDOWS\system32\notepad.exe';

    command_line := '';

    window_handle := ExecApplication (app_name, command_line, proc_id);
end;
In the code above, we run Notepad. Here windows_handle is the handle of Notepad window.

4. put this on FormClose event:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    CloseMessage (proc_id);
end;

5. Example
Here are examples of what we can do with the application's handle:
procedure TForm1.cmdDoSomethingClick(Sender: TObject);
begin
    if window_handle > 0 then
        SetWindowText (window_handle, PChar ('Hello'));  // change title

    ShowWindow (window_handle, SW_SHOW);                 // activate the window
    PostMessage (window_handle, WM_CLOSE, 0, 0);         // close the window
end;

Source : Here

Wednesday 30 November 2016

Incrementing Progress Bar From a ForEach Loop

A deceptively simple question – how do you update a progress bar from a ForEach loop – popped up on the Google+ OmniThreadLibrary community. The implementation turned out to be quite tricky so this is an explaining example created by Primož Gabrijelčič (55_ForEachProgress) which is now part of the OmniThreadLibrary SVN repository.

The starting point was a simple Parallel.ForEach loop which he further simplified in the demo.
Parallel
    .ForEach(1, CNumLoop)
    .Execute(
    procedure (const task: IOmniTask; const i: integer)
    begin
      // do some work
      Sleep(1);

      // update the progress bar - how?
    end
  );

We cannot simply update the progress bar from the ForEach executor as that code executes in a background thread and one must never ever access VCL GUI from a background thread! It is also no good to send “please update” Windows messages to main thread as Parallel.ForEach is by default blocking – it waits for all workers to stop working – and messages won’t be processed during ForEach execution.

First part of solution is to make ForEach non-blocking. To do that, we just add a .NoWait modifier. We also have to store the interface returned from Parallel.ForEach call into some global field or ForEach object will be destroyed on the exit from the current method (i.e. the method in which Parallel.ForEach is called).

type
  TfrmForEachWithProgressBar = class(TForm)
    …
  private
    FWorker: IOmniParallelLoop< integer>;
  end;
  FWorker := Parallel
    .ForEach(1, CNumLoop)
    .NoWait;

The problem now is how to destroy the FWorker interface. Parallel.ForEach provides an OnStop delegate which is called when the last worker thread finishes its job. The delegate is, however, called from the worker thread so we must not destroy FWorker in there. That would cause the ForEach object to be destroyed while the last worker is still running and would lead to a crash or a hanged program. A correct way is to schedule the cleanup to the main thread by using the Invoke method.
// reference must be kept in a global field so that the task controller 
  // is not destroyed before the processing ends
  FWorker := Parallel
    .ForEach(1, CNumLoop)
    .NoWait // important, otherwise message loop will be blocked while 
            // ForEach waits for all tasks to terminate
    .OnStop(
      procedure (const task: IOmniTask)
      begin
        // because of NoWait, OnStop delegate is invoked from the worker code;
        // we must not destroy the worker at that point or the program will
        // block or crash
        task.Invoke(
          procedure begin
            FWorker := nil;
          end
        );
      end
    );

Just a side note – I oh so miss type inference and better anonymous method syntax in Delphi! In Smart, OnStop handler would be written as
.OnStop(
  lambda(task)
    task.Invoke(lambda FWorker := nil; end); 
  end);
Destruction being taken care of, we still have to update the progress bar. To do that, worker calls IncrementProgressBar method via the Invoke mechanism (so that it is executed in the main thread and can update the VCL).
FWorker.Execute(
    procedure (const task: IOmniTask; const i: integer)
    begin
      // do some work
      Sleep(1);

      // update the progress bar
      // we cannot use 'i' for progress as it does not increase sequentially
      // IncrementProgressBar uses internal counter to follow the progress
      task.Invoke(IncrementProgressBar);
    end
  );

Because the values of i are not passed in order to the worker method, we cannot use them to determine the progress. Instead, the main form keeps its own count of work to be done. It is initialized before the Parallel.ForEach is created.
pbForEach.Max := 100;
  pbForEach.Position := 0;
  pbForEach.Update;
  FProgress := 0;
  FPosition := 0;

In the end, IncrementProgressBar, well, increments the progress bar. It also makes sure that we don’t overflow the Windows control with messages.
procedure TfrmForEachWithProgressBar.IncrementProgressBar;
var
  newPosition: integer;
begin
  Inc(FProgress);
  newPosition := Trunc((FProgress / CNumLoop)*pbForEach.Max);

  // make sure we don't overflow TProgressBar with messages
  if newPosition <> FPosition then begin
    pbForEach.Position := newPosition;
    FPosition := newPosition;
  end;
end;

If you are enumerating over a very large range, you’ll also want to reduce number of Invoke(IncrementProgressBar) calls. Each Invoke causes a Windows message to be sent and sending millions of messages will negatively affect the program performance. The simplest way to do that is to only call IncrementProgressBar if the loop counter is a nice rounded value, for example:
if (i mod 1000) = 0 then
        task.Invoke(IncrementProgressBar);

This is just for self learning and self archives
All credits go to the original creator.
Source: originally written by Primož Gabrijelčič here




Monday 28 November 2016

Message Queue with a TThread Worker Using OmniThreadLibrary’s

A simple example, now part of the OTL repository (stored in the folder examples\TThread communication).Two separate topics are covered in this example:
  • Sending data from any thread (main or background) to a TThread-based worker.
  • Sending data from a TThread-based worker to a form.
Let’s deal with them one by one.
1. Sending data from multiple producers to a single worker
To send data form a form to a thread, we need a message queue. This example uses a TOmniMessageQueue object for that purpose. An instance of this object is created in the main thread. All threads – the main thread, the worker threads, and possible other data-producing threads – use the same shared object which is written with thread-safety in mind.

1.a Initialization and cleanup
The TOmniMessageQueue constructor takes a maximum queue size for a parameter. TWorker is just a simple TThread descendant which accepts the instance of the message queue as a parameter so it can read from the queue.
FCommandQueue := TOmniMessageQueue.Create(1000);
FWorker       := TWorker.Create(FCommandQueue);  
The shutdown sequence is fairly standard. Stop is used instead of Terminate so it can set internal event which is used to signal the thread to stop.
if assigned(FWorker) then   
 begin   
  FWorker.Stop;  
  FWorker.WaitFor;  
  FreeAndNil(FWorker);  
 end;  
  FreeAndNil(FCommandQueue);  

1.b Sending data to the worker
To put some data into a queue, use its Enqueue method. It accepts a TOmniMessage record. Each TOmniMessage contains an integer message ID (not used in this example) and a TOmniValue data which, in turn, can hold any data type.
procedure TfrmTThreadComm.Query(value: integer);  
 begin   
  if not FCommandQueue.Enqueue(TOmniMessage.Create(0 {ignored}, value)) then    
    raise Exception.Create('Command queue is full!');  
 end;  
Enqueue returns False if the queue is full. (A TOmniMessageQueue can only hold as much elements as specified in the constructor call.)

The example also shows how everything works correctly if two threads are started at the same time and both write to the message queue.

var  
  th1: TThread;  
  th2: TThread;  
 begin  
  th1 := TThread.CreateAnonymousThread(  
   procedure  
   begin  
    Query(Random(1000));  
   end);  
  th2 := TThread.CreateAnonymousThread(  
   procedure  
   begin  
    Query(Random(1000));  
   end);  
  th1.Start;  
  th2.Start;  
 end;  
1.c Receiving the data
The worker’s Execute method waits on two handles in a loop. If a FStopEvent (an internal event) is signalled, the loop will exit. If the message queue’s GetNewMessageEvent (a THandle-returning method) gets signalled, a new data has arrived to the queue. In that case, the code loops to empty the message queue and then waits again for something to happen.
procedure TWorker.Execute;  
 var 
   handles: array [0..1] of THandle;   
   msg  : TOmniMessage;  
 begin  
  handles[0] := FStopEvent.Handle;  
  handles[1] := FCommandQueue.GetNewMessageEvent;  
  while WaitForMultipleObjects(2, @handles, false, INFINITE)  
   = (WAIT_OBJECT_0 + 1) do  
  begin  
   while FCommandQueue.TryDequeue(msg) do  
   begin  
   //process the message …    
   end;   
  end;  
 end;
  
2. Sending data from a worker to the form
To send messages from a worker thread to a form we need another instance of TOmniMessageQueue. As we can’t wait on a handle in the main thread (that would block the user interface), we’ll use a different notification mechanism – a window message observer.

2.a Initialization and cleanup
We create the queue just as in the first part. Then we create a window message observer and at the end we Attach it to the message queue. A window message observer sends a window message to some window each time a message queue changes. The four parameters passed to CreateContainerWindowsMessageObserver are the handle of the window that will receive those messages, a message ID, WPARAM, and LPARAM.
FResponseQueue.ContainerSubject.Detach(FResponseObserver,coiNotifyOnAllInserts);  
 FreeAndNil(FResponseObserver);  
 ProcessResults;  
 FreeAndNil(FResponseQueue);  

While shutting down, we first have to Detach the observer from the queue. Then we destroy the observer and empty the response queue (ProcessResults) to process any results that may still be waiting inside.
FResponseQueue.ContainerSubject.Detach(FResponseObserver,coiNotifyOnAllInserts);  
FreeAndNil(FResponseObserver);  
ProcessResults;  
FreeAndNil(FResponseQueue);  
2.b Sending data to the form
To send a data, we use exactly the same approach as in 1.b.
if not FResponseQueue.Enqueue(TOmniMessage.Create(0 {ignored},  
      Format('= %d', [msg.MsgData.AsInteger * 2]))) then raise Exception.Create('Response queue is full!');  
2.c Receiving the data
On the receiving side (the form) we have to set up a message function associated with the message that is sent from the window message observer. In this method we’ll call another method ProcessResults.
const  MSG_WORKER_RESULT = WM_USER;
procedure WorkerResult(var msg: TMessage); message MSG_WORKER_RESULT;
procedure TfrmTThreadComm.WorkerResult(var msg: TMessage);
begin  
  ProcessResults;
end;
As a final step, ProcessResults reads data from the message queue and displays each element in a listbox.
procedure TfrmTThreadComm.ProcessResults;  
 var   
  msg: TOmniMessage;  
 begin   
  while FResponseQueue.TryDequeue(msg) do   
   begin    
    //msg.MsgID is ignored in this demo    
    //msg.MsgData contains a string, generated by the worker    
    lbLog.ItemIndex := lbLog.Items.Add(msg.MsgData);  
   end;  
 end;
  
3. Using a TOmniBlockingCollection instead of TOmniMessageQueue
Alternatively, you can use the blocking collection implementation from OtlCollections instead. A blocking collection would be appropriate in case you have to handle large number of work requests or responses stored in a queue as a blocking collection grows and shrinks dynamically.

The only important change to the code would be in part 1 as you’d have to create an event observer manually while TOmniMessageQueue does it automatically. For details you can check TOmniMessageQueue.AttachWinEventObserver and TOmniMessageQueue.Destroy.

Source : This post was written originally by : Primož Gabrijelčič Here