* Add system.analytics for Delphi compatibility

packages/vcl-compat/fpmake.pp

@@ -43,6 +43,7 @@ begin
     T:=P.Targets.AddUnit('system.ioutils.pp');
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.devices.pp');
+    T:=P.Targets.AddUnit('system.analytics.pp');
 
 
 {$ifndef ALLPACKAGES}

packages/vcl-compat/src/system.analytics.pp

@@ -0,0 +1,166 @@
+unit System.Analytics;
+
+{$MODE OBJFPC}
+{$SCOPEDENUMS ON}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.SysUtils, System.Contnrs, System.Classes;
+{$ELSE}
+uses
+  sysutils, contnrs, classes;
+{$ENDIF}
+
+
+type
+  IApplicationActivityCacheManager = interface ['{6145E812-8ECA-4B69-994C-26A81B2A84DC}']
+    function GetCacheCount: Integer;
+    procedure PersistData(const Wait: Boolean);
+    procedure ClearData;
+    procedure Log(const AMessage: string);
+    procedure RemoveEventAtIndex(const Index: Integer);
+    function GetEventAtIndex(const Index: Integer): string;
+    procedure SetOnDataCacheFull(const AValue: TNotifyEvent);
+    function GetOnDataCacheFull: TNotifyEvent;
+    procedure SetMaxCacheSize(const AValue: Integer);
+    function GetMaxCacheSize: Integer;
+    property CacheCount: Integer read GetCacheCount;
+    property MaxCacheSize: Integer read GetMaxCacheSize write SetMaxCacheSize;
+    property Event[const Index: Integer]: string read GetEventAtIndex;
+    property OnDataCacheFull: TNotifyEvent read GetOnDataCacheFull write SetOnDataCacheFull;
+  end;
+
+  IAppAnalyticsStartupDataRecorder = interface ['{783ED8DB-86BC-41C7-BBD3-443C19468FF1}']
+    procedure AddEnvironmentField(const AKey, AValue: string);
+  end;
+
+
+  IApplicationActivityListener = interface ['{A67DE237-F274-4028-AAC8-DA0BDA0D5D78}']
+    procedure TrackAppStart(const aTimeStamp: TDateTime);
+    procedure TrackAppExit(const aTimeStamp: TDateTime);
+    procedure TrackControlFocused(const aTimeStamp: TDateTime; const aSender: TObject);
+    procedure TrackWindowActivated(const aTimeStamp: TDateTime; const aSender: TObject);
+    procedure TrackEvent(const aTimeStamp: TDateTime; const aSender, aContext: TObject);
+    procedure TrackException(const aTimeStamp: TDateTime; const E: Exception);
+  end;
+
+
+  TAppActivity = (AppStart, AppExit, ControlFocused, WindowActivated, Exception, Custom);
+  TAppActivityOptions = set of TAppActivity;
+
+  TAnalyticsManager = class
+  private
+    FClients: TInterfaceList;
+    function GetTrackingEnabled: Boolean;
+    function GetClientCount : Integer;
+    function GetClient(aIndex : Integer) : IApplicationActivityListener;
+  Protected  
+    Property Clients[aIndex : Integer] : IApplicationActivityListener Read GetClient;
+    Property ClientCount : Integer Read GetClientCount;
+  public
+    destructor Destroy; override;
+    procedure RegisterActivityListener(const aListener: IApplicationActivityListener);
+    procedure UnregisterActivityListener(const aListener: IApplicationActivityListener);
+    procedure RecordActivity(const aActivity: TAppActivity); overload;
+    procedure RecordActivity(const aActivity: TAppActivity; const aSender: TObject); overload;
+    procedure RecordActivity(const aActivity: TAppActivity; const aSender: TObject; const aContext: TObject); overload;
+    property TrackingEnabled: Boolean read GetTrackingEnabled;
+  end;
+
+  EAnalyticsInitializationFailed = class(Exception);
+
+implementation
+
+{ TAnalyticsManager }
+
+destructor TAnalyticsManager.Destroy;
+begin
+  FreeAndNil(FClients);
+  inherited;
+end;
+
+function TAnalyticsManager.GetClientCount : Integer;
+
+begin
+  if not assigned(FClients) then
+    Result:=0
+  else
+    Result:=FClients.Count;    
+end;
+
+function TAnalyticsManager.GetClient(aIndex : Integer) : IApplicationActivityListener;
+
+begin
+  if not Assigned(FClients) then
+    Raise EListError.Create('Index (%d) out of bounds');
+  Result:=(FClients[aIndex]) as IApplicationActivityListener;
+end;
+
+procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity);
+begin
+  RecordActivity(aActivity,nil,nil);
+end;
+
+procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity; const aSender: TObject);
+begin
+  RecordActivity(aActivity,aSender,nil);
+end;
+
+function TAnalyticsManager.GetTrackingEnabled: Boolean;
+begin
+  Result:=(ClientCount>0)
+end;
+
+procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity; const aSender,aContext: TObject);
+
+var
+  I  : Integer;
+  TS : TDateTime;
+  A  : IApplicationActivityListener;
+  
+begin
+  if ClientCount=0 then 
+    exit;
+  TS:=Now;
+  for I:=0 to ClientCount-1 do
+    begin
+    A:=Clients[I];
+    case aActivity of
+      TAppActivity.AppStart:
+        A.TrackAppStart(Ts);
+      TAppActivity.AppExit:
+        A.TrackAppExit(Ts);
+      TAppActivity.ControlFocused:
+        A.TrackControlFocused(Ts,aSender);
+      TAppActivity.WindowActivated:
+        A.TrackWindowActivated(Ts,aSender);
+      TAppActivity.Exception:
+        if aSender is Exception then
+          A.TrackException(Ts,Exception(aSender));
+      TAppActivity.Custom:
+        A.TrackEvent(Ts,aSender,aContext);
+    end;
+    A:=Nil;
+    end;
+end;
+
+procedure TAnalyticsManager.RegisterActivityListener(const aListener: IApplicationActivityListener);
+
+begin
+  if Not Assigned(FClients) then
+    FClients:=TInterfaceList.Create
+  else if FClients.IndexOf(aListener)<>-1 then
+    Exit;
+  FClients.Add(aListener);
+end;
+
+
+procedure TAnalyticsManager.UnregisterActivityListener(const aListener: IApplicationActivityListener);
+begin
+  if Assigned(FClients) then
+    FClients.Remove(aListener);
+end;
+
+end.

packages/vcl-compat/tests/testcompat.lpi

@@ -44,6 +44,10 @@
         <Filename Value="utcdevices.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="utcanalytics.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/vcl-compat/tests/testcompat.lpr

@@ -4,7 +4,7 @@ program testcompat;
 
 uses
   {$IFDEF UNIX}cwstring,{$ENDIF}
-  Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices;
+  Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices, utcanalytics;
 
 type
 

packages/vcl-compat/tests/utcanalytics.pas

@@ -0,0 +1,256 @@
+unit utcanalytics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, system.analytics;
+
+type
+
+  { TListener }
+
+  TListener = Class(TInterfacedObject,IApplicationActivityListener)
+  private
+    FLastActivity: TAppActivity;
+    FLastContext: TObject;
+    FLastSender: TObject;
+    FLastTimeStamp: TDateTime;
+  Protected
+    procedure TrackAppStart(const TimeStamp: TDateTime);
+    procedure TrackAppExit(const TimeStamp: TDateTime);
+    procedure TrackControlFocused(const TimeStamp: TDateTime; const Sender: TObject);
+    procedure TrackWindowActivated(const TimeStamp: TDateTime; const Sender: TObject);
+    procedure TrackEvent(const TimeStamp: TDateTime; const Sender, Context: TObject);
+    procedure TrackException(const TimeStamp: TDateTime; const E: Exception);
+  Public
+    Procedure Reset;
+    Property LastTimestamp : TDateTime Read FLastTimeStamp;
+    Property LastActivity : TAppActivity Read FLastActivity;
+    Property LastSender : TObject Read FLastSender;
+    Property LastContext : TObject Read FLastContext;
+  end;
+
+  { TTestAnalytics }
+
+  TTestAnalytics= class(TTestCase)
+  private
+    FListener: TListener;
+    FListener2: TListener;
+    FListenerIntf : IApplicationActivityListener;
+    FListener2Intf : IApplicationActivityListener;
+    FManager: TAnalyticsManager;
+    FTime: TDateTime;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure Register;
+    Procedure AssertEquals(const Msg : String; aExpected, aActual : TAppActivity); overload;
+    procedure AssertEvent(const Msg: String; aListener: TListener;
+      aActivity: TAppActivity; aSender: TObject = Nil; aContext: TObject = Nil);
+    property Manager : TAnalyticsManager Read FManager;
+    Property Listener : TListener Read FListener;
+    Property Listener2 : TListener Read FListener2;
+  published
+    procedure TestHookUp;
+    procedure TestRegister;
+    Procedure TestAppStart;
+    procedure TestAppExit;
+    procedure TestFocused;
+    procedure TestWindowActivated;
+    procedure TestEvent;
+    procedure TestException;
+    procedure TestUnRegister;
+  end;
+
+implementation
+
+uses typinfo;
+
+{ TListener }
+
+procedure TListener.TrackAppStart(const TimeStamp: TDateTime);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.AppStart;
+end;
+
+procedure TListener.TrackAppExit(const TimeStamp: TDateTime);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.AppExit;
+end;
+
+procedure TListener.TrackControlFocused(const TimeStamp: TDateTime;
+  const Sender: TObject);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.ControlFocused;
+  FLastSender:=Sender;
+  FLastContext:=Nil;
+end;
+
+procedure TListener.TrackWindowActivated(const TimeStamp: TDateTime;
+  const Sender: TObject);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.WindowActivated;
+  FLastSender:=Sender;
+  FLastContext:=Nil;
+end;
+
+procedure TListener.TrackEvent(const TimeStamp: TDateTime; const Sender,
+  Context: TObject);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.Custom;
+  FLastSender:=Sender;
+  FLastContext:=Context;
+end;
+
+procedure TListener.TrackException(const TimeStamp: TDateTime;
+  const E: Exception);
+begin
+  FLastTimeStamp:=TimeStamp;
+  FLastActivity:=TAppActivity.Exception;
+  FLastSender:=E;
+  FLastContext:=Nil;
+end;
+
+procedure TListener.Reset;
+begin
+  FLastActivity:=Default(TAppActivity);
+  FLastContext:=Default(TObject);
+  FLastSender:=Default(TObject);
+  FLastTimeStamp:=Default(TDateTime);
+end;
+
+procedure TTestAnalytics.TestHookUp;
+begin
+  AssertNotNull('Have manager',Manager);
+  AssertNotNull('Have listener',Listener);
+end;
+
+procedure TTestAnalytics.TestRegister;
+begin
+  Register;
+  AssertTrue('Tracking enabled',Manager.TrackingEnabled);
+end;
+
+procedure TTestAnalytics.TestAppStart;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.AppStart);
+  AssertEvent('Listener 1',Listener,TAppActivity.AppStart);
+  AssertEvent('Listener 2',Listener2,TAppActivity.AppStart);
+end;
+
+procedure TTestAnalytics.TestAppExit;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.AppExit);
+  AssertEvent('Listener 1',Listener,TAppActivity.AppExit);
+  AssertEvent('Listener 2',Listener2,TAppActivity.AppExit);
+end;
+
+procedure TTestAnalytics.TestFocused;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.ControlFocused,Self);
+  AssertEvent('Listener 1',Listener,TAppActivity.ControlFocused,Self,Nil);
+  AssertEvent('Listener 2',Listener2,TAppActivity.ControlFocused,Self,Nil);
+end;
+
+procedure TTestAnalytics.TestWindowActivated;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.WindowActivated,Self,Nil);
+  AssertEvent('Listener 1',Listener,TAppActivity.WindowActivated,Self,Nil);
+  AssertEvent('Listener 2',Listener2,TAppActivity.WindowActivated,Self,Nil);
+end;
+
+procedure TTestAnalytics.TestEvent;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.Custom,Self,Listener);
+  AssertEvent('Listener 1',Listener,TAppActivity.Custom,Self,Listener);
+  AssertEvent('Listener 2',Listener2,TAppActivity.Custom,Self,Listener);
+end;
+
+procedure TTestAnalytics.TestException;
+
+var
+  E : Exception;
+
+begin
+  Register;
+  E:=Exception.Create('Soso');
+  try
+    Manager.RecordActivity(TAppActivity.Exception,E);
+    AssertEvent('Listener 1',Listener,TAppActivity.Exception,E);
+    AssertEvent('Listener 2',Listener2,TAppActivity.Exception,E);
+  finally
+    E.Free;
+  end;
+end;
+
+procedure TTestAnalytics.TestUnRegister;
+begin
+  Register;
+  Manager.RecordActivity(TAppActivity.AppExit);
+  AssertEvent('Listener 1',Listener,TAppActivity.AppExit);
+  AssertEvent('Listener 2',Listener2,TAppActivity.AppExit);
+  Manager.UnregisterActivityListener(FListener2Intf);
+  Listener2.Reset;
+  Manager.RecordActivity(TAppActivity.AppExit);
+  AssertEvent('Listener 1',Listener,TAppActivity.AppExit);
+  AssertEquals('Listener2',0,Listener2.LastTimestamp);
+end;
+
+procedure TTestAnalytics.SetUp;
+begin
+  FManager:=TAnalyticsManager.Create;
+  FListener:=TListener.Create;
+  FListenerIntf:=FListener as IApplicationActivityListener;
+  FListener2:=TListener.Create;
+  FListener2Intf:=FListener2 as IApplicationActivityListener;
+end;
+
+procedure TTestAnalytics.TearDown;
+begin
+  FreeAndNil(FManager);
+  // FreeAndNil(FListener);
+  FListenerIntf:=Nil; // Will free
+  FListener:=nil;
+  FListener2Intf:=Nil; // Will free
+  FListener2:=nil;
+end;
+
+procedure TTestAnalytics.Register;
+begin
+  Manager.RegisterActivityListener(Listener as IApplicationActivityListener);
+  Manager.RegisterActivityListener(Listener2 as IApplicationActivityListener);
+  FTime:=Now;
+end;
+
+procedure TTestAnalytics.AssertEquals(const Msg: String; aExpected, aActual: TAppActivity);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TAppActivity),Ord(aExpected)),
+                   GetEnumName(TypeInfo(TAppActivity),Ord(aActual)));
+end;
+
+procedure TTestAnalytics.AssertEvent(const Msg: String; aListener: TListener;
+  aActivity: TAppActivity; aSender: TObject; aContext: TObject);
+begin
+  AssertEquals(Msg+' activity',aActivity,aListener.LastActivity);
+  AssertTrue(Msg+' timestamp',aListener.LastTimestamp>=FTime);
+  AssertSame(Msg+' sender',aSender,aListener.LastSender);
+  AssertSame(Msg+' context',aContext,aListener.LastContext);
+end;
+
+initialization
+
+  RegisterTest(TTestAnalytics);
+end.
+