* TLoginCredentialService for Delphi compatibility

packages/vcl-compat/fpmake.pp

@@ -62,6 +62,8 @@ begin
     T.Dependencies.AddUnit('system.json');
     T:=P.Targets.AddUnit('system.hash.pp');
     T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('system.credentials.pp');
+    T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.regularexpressionsconsts.pp',[Win64,Linux,darwin]);
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.regularexpressionscore.pp',[Win64,Linux,darwin]);

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

@@ -0,0 +1,232 @@
+unit system.credentials;
+
+interface
+{$mode objfpc}
+{$h+}
+{$modeswitch functionreferences}
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses System.SysUtils, System.Classes, System.Contnrs;
+{$ELSE}
+uses SysUtils, Classes, Contnrs;
+{$ENDIF}
+
+Type
+  ELoginCredentialError = class(Exception);
+
+  { TLoginCredentialService }
+
+  TLoginCredentialService = class sealed
+  public const
+    Default        = '';
+    DefaultUsrPw   = 'DefaultUsrPw';
+    DefaultUsrPwDm = 'DefaultUsrPwDm'; 
+  public type
+    TLoginFunc = reference to function (const Username, Password, Domain: string): Boolean;
+    TLoginEvent = procedure (Sender: TObject; const Username, Password, Domain: string; var Handled: Boolean) of object;
+    TLoginCredentialEvent = procedure (Sender: TObject; Callback: TLoginEvent; var Success: Boolean) of object;
+  private 
+    type
+
+      { TRegisteredHandler }
+
+      TRegisteredHandler = class (TObject)
+        FEvent: TLoginCredentialEvent;
+        constructor Create(aEvent: TLoginCredentialEvent);
+      end;
+
+    class var _Handlers: TStringList;
+    class constructor Create;
+    class destructor Destroy;
+    class function FindLoginCredentialEvent(const aContext: string): TLoginCredentialEvent;
+    class function DoGetLoginCredentialEvent(const aContext: string): TLoginCredentialEvent;
+    class function IndexOfHandler(const aContext: String; aEvent: TLoginCredentialEvent): Integer;
+  public
+    Class procedure Clear;
+    class procedure RegisterLoginHandler(const aContext: string; const aEvent: TLoginCredentialEvent); static;
+    class procedure UnregisterLoginHandler(const aContext: string; const aEvent: TLoginCredentialEvent); static;
+    class function HandlerCount : Integer;
+
+    class function GetLoginCredentialEvent(const aContext: string): TLoginCredentialEvent; static;
+    class function GetLoginCredentials(const aContext: string; Sender: TObject; const aCallback: TLoginEvent): Boolean; overload; static;
+    class function GetLoginCredentials(const aContext: string; const aCallback: TLoginFunc): Boolean; overload; static;
+    class function GetLoginCredentials(const aContext: string; var aUsername, aPassword: string): Boolean; overload; static;
+    class function GetLoginCredentials(const aContext: string; var aUsername, aPassword, aDomain: string): Boolean; overload; static;
+  end;
+
+Implementation
+
+Resourcestring
+  SServiceNotFound = 'Service %s not found';
+
+{ TLoginCredentialService }
+
+class constructor TLoginCredentialService.Create;
+begin
+  _handlers:=TStringList.Create(True);
+end;
+
+class destructor TLoginCredentialService.Destroy;
+begin
+  FreeAndNil(_Handlers)
+end;
+
+class function TLoginCredentialService.IndexOfHandler(const aContext : String; aEvent: TLoginCredentialEvent): Integer;
+
+Var
+  MC, M : TMethod;
+  I : Integer;
+
+begin
+  Result:=-1;
+  MC:=TMethod(aEvent);
+  For I:=_Handlers.Count-1 downto 0 do
+    if (_Handlers[I]=aContext) then
+      begin
+      M:=TMethod(TRegisteredHandler(_Handlers.Objects[i]).FEvent);
+      If ((M.Data=MC.Data) and (M.Code=MC.Code))  then
+        Exit(I);
+      end;
+end;
+
+class procedure TLoginCredentialService.Clear;
+begin
+  _Handlers.Clear;
+end;
+
+class procedure TLoginCredentialService.RegisterLoginHandler(const aContext: string; const aEvent: TLoginCredentialEvent);
+begin
+  if (IndexOfHandler(aContext,aEvent)=-1) then
+    _Handlers.AddObject(aContext,TRegisteredHandler.Create(aEvent));
+end;
+
+class procedure TLoginCredentialService.UnregisterLoginHandler(const aContext: string; const aEvent: TLoginCredentialEvent);
+
+var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfHandler(aContext,aEvent);
+  if (Idx<>-1) then
+    _Handlers.Delete(idx);
+end;
+
+class function TLoginCredentialService.HandlerCount: Integer;
+begin
+  Result:=_Handlers.Count;
+end;
+
+class function TLoginCredentialService.DoGetLoginCredentialEvent(const aContext: string): TLoginCredentialEvent;
+
+begin
+  Result:=FindLoginCredentialEvent(aContext);
+  if Not Assigned(Result) then
+    raise ELoginCredentialError.CreateFmt(SServiceNotFound,[aContext]);
+end;
+
+class function TLoginCredentialService.GetLoginCredentialEvent(const aContext: string): TLoginCredentialEvent;
+begin
+  Result:=FindLoginCredentialEvent(aContext);
+end;
+
+class function TLoginCredentialService.FindLoginCredentialEvent(const aContext: string): TLoginCredentialEvent;
+
+var
+  Idx : Integer;
+
+begin
+  Result:=Nil;
+  Idx:=_Handlers.IndexOf(aContext);
+  if Idx=-1 then
+    Idx:=_Handlers.IndexOf('');
+  if Idx<>-1 then
+    Result:=TRegisteredHandler(_Handlers.Objects[Idx]).FEvent;
+end;
+
+class function TLoginCredentialService.GetLoginCredentials(const aContext: string; Sender: TObject; const aCallback: TLoginEvent): Boolean;
+
+var
+  Event: TLoginCredentialEvent;
+
+begin
+  Result:=True;
+  Event:=DoGetLoginCredentialEvent(aContext);
+  Event(Sender,aCallback,Result)
+end;
+
+Type
+
+  { TEventObj }
+
+  TEventObj = Class(TObject)
+    FCallBack : TLoginCredentialService.TLoginFunc;
+    procedure DoCallBack(Sender: TObject; const aUsername, aPassword, aDomain: string; var aHandled: Boolean) ;
+  end;
+
+{ TEventObj }
+
+procedure TEventObj.DoCallBack(Sender: TObject; const aUsername, aPassword, aDomain: string; var aHandled: Boolean);
+begin
+  aHandled:=FCallBack(aUsername,aPassword,aDomain);
+end;
+
+class function TLoginCredentialService.GetLoginCredentials(const aContext: string; const aCallback: TLoginFunc): Boolean;
+
+var
+  Event: TLoginCredentialEvent;
+  Obj : TEventObj;
+
+
+begin
+  Result:=False;
+  Event:=DoGetLoginCredentialEvent(aContext);
+  Obj:=TEventObj.Create;
+  try
+    Obj.FCallBack:=aCallBack;
+    Event(Obj,@Obj.DoCallback,Result);
+  finally
+    Obj.Free;
+  end;
+end;
+
+class function TLoginCredentialService.GetLoginCredentials(const aContext: string; var aUsername, aPassword: string): Boolean;
+
+var
+  Dummy : String;
+
+begin
+  Dummy:='';
+  Result:=GetLoginCredentials(aContext,aUserName,aPassword,Dummy);
+end;
+
+class function TLoginCredentialService.GetLoginCredentials(const aContext: string; var aUsername, aPassword, aDomain: string): Boolean;
+
+Var
+  U,P,D : String;
+
+  function Callback (const UN,PWD,Dom : string): Boolean;
+  begin
+    U:=UN;
+    P:=PWD;
+    D:=Dom;
+    Result:=True;
+  end;
+
+begin
+  Result:=GetLoginCredentials(aContext,@CallBack);
+  if Result then
+    begin
+    aUserName:=U;
+    aPassword:=P;
+    aDomain:=D;
+    end;
+end;
+
+{ TLoginCredentialService.TRegisteredHandler }
+
+constructor TLoginCredentialService.TRegisteredHandler.Create(aEvent: TLoginCredentialEvent);
+begin
+  FEvent:=aEvent;
+end;
+
+end.

packages/vcl-compat/tests/testcompat.lpi

@@ -41,7 +41,7 @@
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="utcdevices.pp"/>
+        <Filename Value="utcdevices.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
@@ -69,17 +69,21 @@
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="utregex.pas"/>
+        <Filename Value="utcregex.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="utregexapi.pas"/>
+        <Filename Value="utcregexapi.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
         <Filename Value="utthreading.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="utccredentials.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/vcl-compat/tests/testcompat.lpr

@@ -7,7 +7,7 @@ uses
   Classes, consoletestrunner, tcnetencoding, tciotuils, 
   utmessagemanager, utcdevices, utcanalytics, utcimagelist, 
   utcnotifications, utcjson, utcpush, utchash, utcregex, 
-  utcregexapi, utthreading;
+  utcregexapi, utthreading, utccredentials;
 
 type
 

packages/vcl-compat/tests/utccredentials.pas

@@ -0,0 +1,204 @@
+unit utccredentials;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, system.credentials, fpcunit, testregistry;
+
+Type
+
+  { TTestCredentials }
+
+  TTestCredentials = class(TTestcase)
+  private
+    FSuccess : Boolean;
+    FUser,FPass,FDom : String;
+    FEventMethod,
+    FEventMethod2 : TMethod;
+    procedure DoLoginEvent(Sender: TObject; Callback: TLoginCredentialService.TLoginEvent; var Success: Boolean);
+    procedure DoLoginEvent2(Sender: TObject; Callback: TLoginCredentialService.TLoginEvent; var Success: Boolean);
+    procedure ReceiveEvent(Sender: TObject; const Username, Password, Domain: string; var Handled: Boolean);
+  Public
+    procedure AssertCredentials(const Msg, aUser, aPassword, aDomain: String);
+    Procedure Setup; override;
+    Procedure TearDown; override;
+  Published
+    Procedure TestHookup;
+    Procedure TestAddHandler;
+    Procedure TestRemoveHandler;
+    Procedure TestGetLoginCredentialEvent;
+    Procedure TestGetloginCredentials;
+    procedure TestGetloginCredentials2;
+    procedure TestGetloginCredentials3;
+  end;
+
+implementation
+
+{ TTestCredentials }
+
+procedure TTestCredentials.DoLoginEvent(Sender: TObject; Callback: TLoginCredentialService.TLoginEvent; var Success: Boolean);
+begin
+  CallBack(Sender,FUser,FPass,FDom,Success);
+end;
+
+procedure TTestCredentials.DoLoginEvent2(Sender: TObject; Callback: TLoginCredentialService.TLoginEvent; var Success: Boolean);
+begin
+  CallBack(Sender,FUser+'2',FPass+'2',FDom+'2',Success);
+end;
+
+procedure TTestCredentials.AssertCredentials(const Msg, aUser, aPassword, aDomain: String);
+
+begin
+  AssertEquals(Msg+': User',FUser,aUser);
+  AssertEquals(Msg+': Password',FPass,aPassword);
+  AssertEquals(Msg+': Domain',FDom,aDomain);
+end;
+
+procedure TTestCredentials.Setup;
+begin
+  inherited Setup;
+  TLoginCredentialService.Clear;
+  FEventMethod2:=TMethod(@Self.DoLoginEvent2);
+  FEventMethod:=TMethod(@Self.DoLoginEvent);
+  FUser:='U';
+  FPass:='P';
+  FDom:='D';
+  FSuccess:=True;
+end;
+
+procedure TTestCredentials.TearDown;
+begin
+  inherited TearDown;
+end;
+
+procedure TTestCredentials.TestHookup;
+begin
+  AssertEquals('handler count',0,TLoginCredentialService.HandlerCount);
+  AssertEquals('Default user','U',FUser);
+  AssertEquals('Default pwd','P',FPass);
+  AssertEquals('Default Dom','D',FDom);
+end;
+
+procedure TTestCredentials.TestAddHandler;
+begin
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count a',1,TLoginCredentialService.HandlerCount);
+  TLoginCredentialService.RegisterLoginHandler('y',@DoLoginEvent);
+  AssertEquals('handler count b',2,TLoginCredentialService.HandlerCount);
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count c',2,TLoginCredentialService.HandlerCount);
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent2);
+  AssertEquals('handler count d',3,TLoginCredentialService.HandlerCount);
+end;
+
+procedure TTestCredentials.TestRemoveHandler;
+
+begin
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count a',1,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.RegisterLoginHandler('y',@DoLoginEvent);
+  AssertEquals('handler count b',2,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count c',2,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent2);
+  AssertEquals('handler count d',3,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.UnRegisterLoginHandler('x',@DoLoginEvent2);
+  AssertEquals('handler count e',2,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.UnRegisterLoginHandler('z',@DoLoginEvent2);
+  AssertEquals('handler count f',2,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.UnRegisterLoginHandler('y',@DoLoginEvent);
+  AssertEquals('handler count g',1,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.UnRegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count h',0,TLoginCredentialService.HandlerCount);
+end;
+
+procedure TTestCredentials.TestGetLoginCredentialEvent;
+
+var
+  E : TLoginCredentialService.TLoginCredentialEvent;
+  ME : TMethod;
+begin
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertEquals('handler count a',1,TLoginCredentialService.HandlerCount);
+
+  TLoginCredentialService.RegisterLoginHandler('y',@DoLoginEvent2);
+  AssertEquals('handler count b',2,TLoginCredentialService.HandlerCount);
+
+  E:=TLoginCredentialService.GetLoginCredentialEvent('y');
+  ME:=TMethod(E);
+  AssertTrue('Same method',(ME.Code=FEventMethod2.Code) and (ME.Data=FEventMethod2.Data));
+
+  E:=TLoginCredentialService.GetLoginCredentialEvent('x');
+  ME:=TMethod(E);
+  AssertTrue('Same method',(ME.Code=FEventMethod.Code) and (ME.Data=FEventMethod.Data));
+  E:=TLoginCredentialService.GetLoginCredentialEvent('z');
+  AssertTrue('Same method',E=Nil);
+end;
+
+procedure TTestCredentials.TestGetloginCredentials;
+
+var
+  U,P,D : String;
+begin
+
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertTrue('Getcreds',TLoginCredentialService.GetLoginCredentials('x',U,P,D));
+  AssertCredentials('Login',U,P,D);
+end;
+
+procedure TTestCredentials.ReceiveEvent(Sender: TObject; const Username, Password, Domain: string; var Handled: Boolean) ;
+
+begin
+  Handled:=FSuccess;
+  AssertSame('Correct sender ',Sender,Self);
+  if FSuccess then
+    AssertCredentials('Login',UserName,Password,Domain);
+end;
+procedure TTestCredentials.TestGetloginCredentials2;
+
+var
+  U,P,D : String;
+  Res : Boolean;
+
+  Function DoReceive(const Username, Password, Domain: string): Boolean;
+  begin
+    Result:=Res;
+    if Res then
+      begin
+      U:=userName;
+      P:=Password;
+      D:=Domain;
+      end;
+  end;
+
+begin
+  Res:=True;
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertTrue('Getcreds success',TLoginCredentialService.GetLoginCredentials('x',@DoReceive));
+  AssertCredentials('Login',U,P,D);
+  Res:=False;
+  AssertFalse('Getcreds fail',TLoginCredentialService.GetLoginCredentials('x',@DoReceive));
+end;
+
+procedure TTestCredentials.TestGetloginCredentials3;
+begin
+  TLoginCredentialService.RegisterLoginHandler('x',@DoLoginEvent);
+  AssertTrue('Getcreds success',TLoginCredentialService.GetLoginCredentials('x',Self,@ReceiveEvent));
+  FSuccess:=False;
+  AssertFalse('Getcreds fail',TLoginCredentialService.GetLoginCredentials('x',Self,@ReceiveEvent));
+end;
+
+
+initialization
+  RegisterTest(TTestCredentials);
+end.
+