Project Updates

It is time for a retrospective now that we have gone through the first half of the year. Projects are coming along and I will be updating  TDPE (Thundax Delphi Physics Engine)  and  PZaggy (Graph tool)  which will have the source code available by the end of the year. I have been working on side projects like ATOM Monitor to keep track of your atom leaks (and yes, Delphi has atom leaks) and my personal repositories where you will find Delphi code snippets and small utilities I have been developing throughout the years and you will be able to download them and use them for free. This is the way to make Delphi community grow and improve the way we develop Delphi apps using the power of the language using: fluent interfaces, delegates, mock objects, Unit tests, etc.

I will be redesigning as well, the entire website to make it more functional with an emphasis on Open Source projects and other really interesting stuff.

So, stay tuned and I look forward to your comments!.

Jordi

DUnit and TCustomAttributes

In this article I am playing with Unit tests and TCustomAttributes as I am working on different ideas to build up a lightweight testing framework.  Basically I liked the idea of TestCase attribute from NUnit and I wanted to do something similar using TCustomAttributes and accessing those attributes using the Delphi RTTI library. To understand better my purposes have a look at the following example extracted from NUnit webpage:

[TestCase(12,3,4)]
[TestCase(12,2,6)]
[TestCase(12,4,3)]
public void DivideTest(int n, int d, int q)
{
  Assert.AreEqual( q, n / d );
}

This simple example will execute three times the method or test using the parameters defined on the test case attributes. What if we could perform something similar? Would not be cool?

Here is what I have done so far:

Creation of the Custom Attributes:

type
  TUserPasswordAttribute = class(TCustomAttribute)
  private
    FPassword: string;
    FUserName: string;
    Fresponse: Boolean;
    procedure SetPassword(const Value: string);
    procedure SetUserName(const Value: string);
    procedure Setresponse(const Value: Boolean);
  public
    constructor Create(aUserName: string; aPassword: string; aResponse : Boolean);
    property UserName: string read FUserName write SetUserName;
    property Password: string read FPassword write SetPassword;
    property response : Boolean read Fresponse write Setresponse;
  end;

  TUserAgeAttribute = class(TCustomAttribute)
  private
    FAge: integer;
    FUserName: String;
    Fresponse: Boolean;
    procedure SetAge(const Value: integer);
    procedure SetUserName(const Value: String);
    procedure Setresponse(const Value: Boolean);
  public
    property UserName : String read FUserName write SetUserName;
    property Age : integer read FAge write SetAge;
    property response : Boolean read Fresponse write Setresponse;
    constructor Create(aUserName : string; aAge : Integer; aResponse : Boolean);
  end;

{ TUserPasswordAttribute }

constructor TUserPasswordAttribute.Create(aUserName, aPassword: string; aResponse : Boolean);
begin
  SetUserName(aUserName);
  SetPassword(aPassword);
  Setresponse(aResponse);
end;

procedure TUserPasswordAttribute.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

procedure TUserPasswordAttribute.Setresponse(const Value: Boolean);
begin
  Fresponse := Value;
end;

procedure TUserPasswordAttribute.SetUserName(const Value: string);
begin
  FUserName := Value;
end;

{ TUserAgeAttribute }

constructor TUserAgeAttribute.Create(aUserName: string; aAge: Integer; aResponse : Boolean);
begin
  SetUserName(aUserName);
  SetAge(aAge);
  Setresponse(aResponse);
end;

procedure TUserAgeAttribute.SetAge(const Value: integer);
begin
  FAge := Value;
end;

procedure TUserAgeAttribute.Setresponse(const Value: Boolean);
begin
  Fresponse := Value;
end;

procedure TUserAgeAttribute.SetUserName(const Value: String);
begin
  FUserName := Value;
end;

Those two custom attributes will serve as an example for what I intend to do. I need to test a login and some data from a current user and those bespoke attributes would be used by the test case.

The Framework:

type
  TAttributeProc = reference to procedure(CustomAttr: TCustomAttribute);

  TFrameworkTestCase = class(TTestCase)
  public
    procedure TestAttributesMethod(CustomProc: TAttributeProc);
  end;

implementation

{ TFrameworkTestCase }

procedure TFrameworkTestCase.TestAttributesMethod(CustomProc: TAttributeProc);
var
  ContextRtti: TRttiContext;
  RttiType: TRttiType;
  RttiMethod: TRttiMethod;
  CustomAttr: TCustomAttribute;
begin
  ContextRtti := TRttiContext.Create;
  try
    RttiType := ContextRtti.GetType(Self.ClassType);
    for RttiMethod in RttiType.GetMethods do
      for CustomAttr in RttiMethod.GetAttributes do
        CustomProc(CustomAttr);
  finally
    ContextRtti.Free;
  end;
end;

As you can see TFrameworkTestCase inherits from TTestCase and it adds the magic of reading the custom attributes and invoking the delegate as many times needed.

Using the small framework:

unit TestUnit1;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit
  being tested.

}

interface

uses
  TestFramework, Windows, Forms, Dialogs, Controls, Classes, RTTI, SysUtils, Variants,
  Graphics, Messages, Unit1, StdCtrls;

type
  TestTLoginCase = class(TFrameworkTestCase)
  strict private
    FLogin: TLogin;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    [TUserPasswordAttribute('User1', 'Password1', True)]
    [TUserPasswordAttribute('User2', 'Password2', True)]
    [TUserPasswordAttribute('User3', 'Password3', True)]
    [TUserPasswordAttribute('User3', '', False)]
    procedure TestUserLogin;
    [TUserAgeAttribute('User1', 26, True)]
    [TUserAgeAttribute('User2', 27, True)]
    [TUserAgeAttribute('User3', 28, False)]
    procedure TestUserAge;
  end;

implementation

procedure TestTLoginCase.SetUp;
begin
  FLogin := TLogin.Create;
end;

procedure TestTLoginCase.TearDown;
begin
  FLogin.Free;
  FLogin := nil;
end;

procedure TestTLoginCase.TestUserAge;
var
  aAge: integer;
  aUserName: string;
  aResponse : boolean;
begin
  TestAttributesMethod(procedure (CustomAttr : TCustomAttribute)
    begin
        if CustomAttr is TUserAgeAttribute then
        begin
          aUserName := TUserAgeAttribute(CustomAttr).UserName;
          aAge := TUserAgeAttribute(CustomAttr).Age;
          aResponse := TUserAgeAttribute(CustomAttr).Response;
          Assert(aResponse=(FLogin.fetchDatauser(aUserName)=aAge), 'Incorrect value ' + aUserName);
        end;
    end);
end;

procedure TestTLoginCase.TestUserLogin;
var
  aPassword: string;
  aUserName: string;
  aResponse : boolean;
begin
  TestAttributesMethod(procedure (CustomAttr : TCustomAttribute)
    begin
        if CustomAttr is TUserPasswordAttribute then
        begin
          aUserName := TUserPasswordAttribute(CustomAttr).UserName;
          aPassword := TUserPasswordAttribute(CustomAttr).Password;
          aResponse := TUserPasswordAttribute(CustomAttr).Response;
          Assert(FLogin.UserLogin(aUserName, aPassword)=aResponse, 'Incorrect user ' + aUserName);
        end;
    end);
end;

initialization
RegisterTest(TestTLoginCase.Suite);

end.

Notice that every test case contains a set of Custom attributes and they will be executed by using a delegate. I have included the Result parameter in the attribute so the test can know the result straight away and inform about it. 

Related links:

• Delphi- mock wizard.
• DUnit.

Fluent Interfaces example using Delphi part II

Here is the second part of this interesting topic. As I'm still trying to redeem myself from my non popular first example, I'm sure this one will reach the expectations. For this example I'm trying to mimic the way LINQ works, using generics and delegates and I have adapted my solution using fluent Interfaces as well. This solution presents a IQueryList which contains a TList<T> which can be queried like we were using SQL. So, we can select certain values and apply a where clause to filter the final list. This example will give you a hint on how to correctly implement fluent interfaces and how to extend this functionality for your applications.

Delegates:

uses
  Generics.Collections, Generics.Defaults;

type
  TProc<T> = procedure (n : T) of Object;
  TProcList<T> = procedure (n : TList<T>) of Object;
  TFunc<T> = reference to function() : T;
  TFuncParam<T, TResult> = reference to function(param : T) : TResult;
  TFuncList<T, TResult> = reference to function(n : TList<T>) : TResult;
  TFuncListSelect<T, TResult> = reference to function(n : TList<T>) : TList<T>;

IQueryList:

IQueryList<T, TResult> = interface
    function Where(const param : TFuncParam<T, TResult>) : IQueryList<T, TResult>;
    function OrderBy(const AComparer: IComparer<T>) : IQueryList<T, TResult>;
    function Select(const param : TFuncListSelect<T, TResult>) : IQueryList<T, TResult>;
    function FillList(const param : TFuncList<T, TResult>) : IQueryList<T, TResult>;
    function Distinct() : IQueryList<T, TResult>;
    function List() : TList<T>;
  end;

  TQueryList<T, TResult> = class(TInterfacedObject, IQueryList<T, TResult>)
  private
    FList : TList<T>;
  protected
    function Where(const param : TFuncParam<T, TResult>) : IQueryList<T, TResult>;
    function FillList(const param : TFuncList<T, TResult>) : IQueryList<T, TResult>;
    function Select(const param : TFuncListSelect<T, TResult>) : IQueryList<T, TResult>;
    function Distinct() : IQueryList<T, TResult>;
    function List() : TList<T>;
    function OrderBy(const AComparer: IComparer<T>) : IQueryList<T, TResult>;
  public
    constructor Create();
    destructor Destroy(); override;
    class function New: IQueryList<T, TResult>;
  end;

constructor TQueryList<T, TResult>.Create();
begin
  FList := TList<T>.Create;
end;

destructor TQueryList<T, TResult>.Destroy;
begin
  if Assigned(FList) then
    FList.Free;
  inherited;
end;

function TQueryList<T, TResult>.Distinct: IQueryList<T, TResult>;
var
  list : TList<T>;
  i : integer;
begin
  list := TList<T>.Create();
  for i := 0 to FList.Count-1 do
  begin
    if not list.Contains(FList[i]) then
      list.Add(FList[i]);
  end;
  FList.Free;
  FList := list;
  result := Self;
end;

function TQueryList<T, TResult>.FillList(const param : TFuncList<T, TResult>): IQueryList<T, TResult>;
begin
  param(FList);
  Result := Self;
end;

function TQueryList<T, TResult>.List: TList<T>;
begin
  result := FList;
end;

class function TQueryList<T, TResult>.New: IQueryList<T, TResult>;
begin
  result := Create;
end;

function TQueryList<T, TResult>.OrderBy(const AComparer: IComparer<T>): IQueryList<T, TResult>;
begin
  FList.Sort(AComparer);
  result := Self;
end;

function TQueryList<T, TResult>.Select(const param: TFuncListSelect<T, TResult>): IQueryList<T, TResult>;
begin
  FList := param(FList);
  result := Self;
end;

function TQueryList<T, TResult>.Where(const param: TFuncParam<T, TResult>): IQueryList<T, TResult>;
var
  list : TList<T>;
  i: Integer;
  Comparer: IEqualityComparer<TResult>;
begin
  list := TList<T>.Create();
  for i := 0 to FList.Count-1 do
  begin
    Comparer := TEqualityComparer<TResult>.Default;
    if not Comparer.Equals(Default(TResult), param(FList[i])) then
      list.Add(FList[i]);
  end;
  FList.Free;
  FList := list;
  result := Self;
end;

Example Implementation <Integer, Boolean>:

procedure DisplayList();
var
  IqueryList : IQueryList<Integer, Boolean>;
  item : integer;
begin
  //Create the list and fill it up with random values
  IqueryList := TQueryList<Integer, Boolean>
    .New()
    .FillList(function ( list : TList<Integer> ) : Boolean
              var k : integer;
              begin
                for k := 0 to 100 do
                  list.Add(Random(100));
                result := true;
              end);

  //Display filtered values
  for item in IqueryList
    .Select(function ( list : TList<Integer> ) : TList<Integer>
              var
                k : integer;
                selectList : TList<Integer>;
              begin
                selectList := TList<Integer>.Create;
                for k := 0 to list.Count-1 do
                begin
                  if Abs(list.items[k]) > 0 then
                    selectList.Add(list.items[k]);
                end;
                list.Free;
                result := selectList;
              end)
    .Where(function ( i : integer) : Boolean
          begin
            result := (i > 50);
          end)
    .Where(function ( i : integer) : Boolean
          begin
            result := (i < 75);
          end)
    .OrderBy(TComparer<integer>.Construct(
         function (const L, R: integer): integer
         begin
           result := L - R; //Ascending
         end
     )).Distinct.List do
          WriteLn(IntToStr(item));
end;

This example fills up an initial list with 100 random numbers and then I query the list to give me all the values from the list which absolute value is greater than 0 and the values are between 50 and 75. From this list I want all the values ordered by value and I do not want repeated numbers (distinct method).

Example Implementation <String, String>:

procedure DisplayStrings();
const
   Chars = '1234567890ABCDEFGHJKLMNPQRSTUVWXYZ!';
var
  S: string;
  IqueryList : IQueryList<String, String>;
  item : String;
begin
  //Fill up the list with random strings
  IqueryList := TQueryList<String, String>
    .New
    .FillList(function ( list : TList<String> ) : String
              var
                k : integer;
                l : Integer;
              begin
                Randomize;
                for k := 0 to 100 do
                begin
                  S := '';
                  for l := 1 to 8 do
                    S := S + Chars[(Random(Length(Chars)) + 1)];
                  list.Add(S);
                end;
                result := '';
              end);
  //Query the list and retrieve all items which contains 'A'
  for item in IqueryList.Where(function ( i : string) : string
          begin
            if AnsiPos('A', i) > 0 then
              result := i;
          end).List do
    WriteLn(item);
end;

The string example is quite similar, it fills up a list with 100 random string values and then it filters the list displaying only items which contains the character "A".

Everything is based on interfaces so the garbage collector can step in and avoid memory leaks and you can find a sound widespread of generics, delegates and chaining methods all in once. This solution gives you control on the way data is treated and it can work with any type as it is using generics.

I have included all those examples in my personal repository on Google project. Please feel free to use it and  comment everything you like/dislike so we all can improve those examples. The Unit testing side includes interesting examples:

Enjoy it!.

I look forward to your comments.

Jordi

Related Links:

• LINQ C# Examples.
• DeHL project.

Monitoring Global Atom Table part III

New version v1.4 has been released as there were few bugs detected. This version also includes a new and very interesting feature, inspecting atoms from windows services. "A Windows Service applications run in a different window station than the interactive station of the logged-on user. A window station is a secure object that contains a Clipboard, a set of global atoms, and a group of desktop objects. Because the station of the Windows service is not an interactive station, dialog boxes raised from within a Windows service application will not be seen and may cause your program to stop responding. Similarly, error messages should be logged in the Windows event log rather than raised in the user interface".

Source : Microsoft.

This actually means that a running service is using a different set of global atoms than the current user. To display those atoms, atom table monitor v1.4 includes an Atom scanner service which uses the same core engine than Atom monitor and retrieves the list of Global atoms and RWM atoms from the system under the window station.

Current version contains: Atom Table monitor v1.4.

- Atom monitor win32 stand-alone tool.

- List of common patterns.

- Atom scanner win32 service.

- Install / Unninstall service batch files.

Session selection screen:

If the service is up and running, we can select the option to display the atoms from the service session. If the service is not detected the monitor will stop itself.

Service session monitoring  RWM atoms:

This screen is displaying the amount of atoms which are being monitored by the service session. You can play with that by creating a small tool to leak atoms and use different configurations from the service. Have a look at my previous post How to run an application under active session account from a windows service.

User session monitoring RWM atoms:

Check out the amount of patterns which match an specific subset of atom strings. This will help you to rapidly identify which atoms are being created and which is the source.

Installing the service:

Use the batch files to install / uninstall ATOMScannerService.exe. Once installed, run it under local account.

Once up and running, select "Monitor Atoms from service session" on Option's tab and press scan atom table.

Related links:

• Monitoring Global Atom Table part I.
• Monitoring Global Atom Table part II.
• atom table monitor google project.

How to run an application under active session account from a Windows service using Delphi

To run an application from a service impersonating an user account, first we need to install "JEDI API Library & Security Code Library" as it contains different interesting OS callings which are really useful in order to achieve our purposes. Once the library has been unzipped, create your own service where the library is located and add the following paths to your search path in your project options:

Then instead of using CreateProcess function to execute an application, we need to use CreateProcessAsUser function. The new process runs in the security context of the user represented by the specified token. The service must be run by the  LocalSystem account which is a predefined local account used by the service control manager. To be able to use the function from jedi-apilib which retrieves the token from the current user we need to use WTSQueryUserToken ( WtsGetActiveConsoleSessionID, hToken ) function. This function will only work under LocalSystem account which has SE_TCB_NAME property enabled, otherwise the query will be false.

Use the following example within your service:

Related links:

• JclMiscel.pas.
• CreateProcessAsUser fast switching.
• Run process from different credentials.
• How to launch a process in a terminal session.
• Calling CreateProcessAsUser from a Service.
• Delphi Services and Local System account.
• Local system account.
• WTSQueryUserToken.