From 5ba5265fe6da4187b4af25f2dbd519529d33bda5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Thu, 26 Oct 2023 23:41:14 +0200
Subject: [PATCH] * Delphi compatibility unit system.permissions

---
 packages/vcl-compat/fpmake.pp                 |   1 +
 packages/vcl-compat/src/system.permissions.pp | 164 ++++++++++++++++++
 2 files changed, 165 insertions(+)
 create mode 100644 packages/vcl-compat/src/system.permissions.pp

diff --git a/packages/vcl-compat/fpmake.pp b/packages/vcl-compat/fpmake.pp
index 8d16f25ec5..f1d7ff9f4b 100644
--- a/packages/vcl-compat/fpmake.pp
+++ b/packages/vcl-compat/fpmake.pp
@@ -36,6 +36,7 @@ begin
     P.IncludePath.Add('src');
 
 
+    T:=P.Targets.AddUnit('system.permissions.pp');
     T:=P.Targets.AddUnit('system.netencoding.pp');
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.ioutils.pp');
diff --git a/packages/vcl-compat/src/system.permissions.pp b/packages/vcl-compat/src/system.permissions.pp
new file mode 100644
index 0000000000..a95eaa3426
--- /dev/null
+++ b/packages/vcl-compat/src/system.permissions.pp
@@ -0,0 +1,164 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2023 the Free Pascal development team
+
+   Generic permissions service class.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+}
+unit System.Permissions;
+
+{$MODE OBJFPC}
+{$H+}
+{$SCOPEDENUMS ON}
+{$modeswitch functionreferences}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils, System.Types;
+{$ELSE}
+  SysUtils, Types;
+{$ENDIF}
+
+type
+  EPermissionException = class(Exception);
+  TProc = reference to procedure;
+    
+  TPermissionStatus = (Granted, Denied, PermanentlyDenied);
+  TPermissionStatusDynArray = array of TPermissionStatus;
+  TClassicPermissionStatusDynArray = TPermissionStatusDynArray;
+  
+  
+  TRequestPermissionsResultEvent = 
+      procedure(Sender: TObject; 
+                const aPermissions: TStringDynArray;
+                const aGrantResults: TPermissionStatusDynArray) of object;
+                                             
+  TRequestPermissionsResultProc = 
+    reference to procedure(const aPermissions: TStringDynArray;
+                           const aGrantResults: TPermissionStatusDynArray);
+
+  TDisplayRationaleEvent = 
+     procedure(Sender: TObject; 
+               const aPermissions: TStringDynArray; 
+               const aPostRationaleProc: TProc) of object;
+  TDisplayRationaleProc = 
+     reference to procedure(const aPermissions: TStringDynArray; 
+                            const aPostRationaleProc: TProc);
+
+  TPermissionsService = class abstract
+  private
+    class function GetDefaultService: TPermissionsService; static;
+  protected
+    class var FDefaultService: TPermissionsService;
+    constructor Create; virtual;
+  public
+    class destructor Done;
+    function IsPermissionGranted(const aPermission: string): Boolean; virtual;
+    function IsEveryPermissionGranted(const aPermissions: TStringDynArray): Boolean; virtual;
+    procedure RequestPermissions(const aPermissions: TStringDynArray;
+                                 const aOnRequestPermissionsResult: TRequestPermissionsResultEvent; 
+                                 aOnDisplayRationale: TDisplayRationaleEvent = nil); overload; virtual;
+    procedure RequestPermissions(const aPermissions: TStringDynArray;
+                                 const aOnRequestPermissionsResult: TRequestPermissionsResultProc; 
+                                 aOnDisplayRationale: TDisplayRationaleProc = nil); overload; virtual;
+    class property DefaultService: TPermissionsService read GetDefaultService;
+  end;
+
+  TPermissionsServiceClass = class of TPermissionsService;
+
+var
+  PermissionsServiceClass: TPermissionsServiceClass = TPermissionsService;
+
+function PermissionsService: TPermissionsService; inline;
+
+implementation
+
+function PermissionsService: TPermissionsService;
+
+begin
+  Result:=TPermissionsService.DefaultService;
+end;
+
+{ ---------------------------------------------------------------------
+  TPermissionsService 
+  ---------------------------------------------------------------------}
+
+class function TPermissionsService.GetDefaultService: TPermissionsService;
+begin
+  if Not Assigned(FDefaultService) then
+    if Assigned(PermissionsServiceClass) then
+      FDefaultService:=PermissionsServiceClass.Create;
+  Result:=FDefaultService;
+end;
+
+
+constructor TPermissionsService.Create;
+begin
+  // Nothing to do
+end;
+
+
+function TPermissionsService.IsPermissionGranted(const aPermission: string): Boolean;
+begin
+  Result:=True;
+end;
+
+
+function TPermissionsService.IsEveryPermissionGranted(const aPermissions: TStringDynArray): Boolean;
+begin
+  Result:=True;
+end;
+
+Function InitResults(aLen : Integer) : TPermissionStatusDynArray; inline;
+
+var
+  I : Integer;
+
+begin
+  Result:=[];
+  SetLength(Result,aLen);
+  for I:=0 to Length(Result)-1 do
+    Result[I]:=TPermissionStatus.Granted;
+end;
+
+procedure TPermissionsService.RequestPermissions(const aPermissions: TStringDynArray;
+                                                 const aOnRequestPermissionsResult: TRequestPermissionsResultEvent; 
+                                                 aOnDisplayRationale: TDisplayRationaleEvent);
+                                                 
+var
+  Res: TPermissionStatusDynArray;
+  I: Integer;
+  
+begin
+  Res:=InitResults(Length(aPermissions));
+  AOnRequestPermissionsResult(Self,aPermissions,Res)
+end;
+
+procedure TPermissionsService.RequestPermissions(const aPermissions: TStringDynArray;
+                                                 const aOnRequestPermissionsResult: TRequestPermissionsResultProc; 
+                                                 aOnDisplayRationale: TDisplayRationaleProc);
+var
+  Res: TPermissionStatusDynArray;
+  I: Integer;
+  
+begin
+  Res:=InitResults(Length(aPermissions));
+  AOnRequestPermissionsResult(aPermissions,TPermissionStatusDynArray(res))
+end;
+
+class destructor TPermissionsService.Done;
+begin
+  FreeAndNil(FDefaultService);
+end;
+
+
+end.