delphi安卓动态权限申请

安卓8及以上版本，除了原来的静态权限申请以外，还需要动态权限申请。

delphi10.3开始支持安卓动态权限申请。

delphi11开始官方改变了安卓动态权限申请的参数类型，导致原来编写的代码，编码报错。

下面的代码，可以很好地解决权限问题。兼顾了delphi10.3和delphi11以后版本。

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

{sensor 2022-07-12 周二  老吴QQ：910731685
 Android 动态申请权限控件
 
 参考：https://developer.android.google.cn/reference/android/Manifest.permission
}
unit uAndroid_Permissions_Component;
 
interface
 
uses
  System.Types,         //TClassicStringDynArray
  System.Permissions,   //TClassicPermissionStatusDynArray
  FMX.DialogService,
  System.UITypes,       //TModalResult
  System.TypInfo,
 
  {$IFDEF DEBUG}
    FMX.Dialogs,
  {$ENDIF}
 
  System.SysUtils,
  System.Classes;
 
const
  Permission_Prefix = 'android.permission.';   //Android 权限字符串的前缀部分
 
 
type
  //如果授权申请成功， GrantedResult=true，NoGranteds无效，否则 GrantedResult=false，NoGranteds表示没有授权的项目列表
  TApplyResult = procedure(const Sender : TObject; GrantedResult : Boolean; NoGranteds : TArray<string>)  of object;
 
  TPermission = (
    ACCESS_COARSE_LOCATION,     //可单独申请 获取大致位置信息Allows an app to access approximate location.
    ACCESS_FINE_LOCATION,       //可单独申请 获取精确位置信息Allows an app to access precise location.
    ACCESS_BACKGROUND_LOCATION, //Androidapi.JNI.Os 没有包含这个权限,实际是支持的。这个权限必须要求ACCESS_COARSE_LOCATION 和 ACCESS_FINE_LOCATION 权限
    ACCESS_MEDIA_LOCATION,      //可单独申请 Allows an application to access any geographic locations persisted in the user's shared collection
 
    //ACCESS_MOCK_LOCATION,  //(obsolete) Android目前已经不支持
    ACTIVITY_RECOGNITION,  // 获取设备中的健身运动信息 Allows an application to recognize physical activity.
    ADD_VOICEMAIL,          // Allows an application to add voicemails into the system.
    ANSWER_PHONE_CALLS,    // 接听或挂断电话、监听通话状态
    //AUTHENTICATE_ACCOUNTS,  // (obsolete)  Android目前已经不支持
 
    BODY_SENSORS,           //获取您的生命体征相关数据
    BODY_SENSORS_BACKGROUND,   // API 33 新增加 后台获取您的生命体征相关数据
    CALL_PHONE,
    CAMERA,
    //CONYINUE_A_CALL_STARTED_IN_ANOTHER_APP,  // Android目前已经不支持   Continue a call started in another app
    GET_ACCOUNTS,               //获取手机账户
    MANAGE_ACCOUNTS,             // Android目前已经不支持 Manage accounts (obsolete)
    //PROCESS_OUTGOING_CALLS,       //
    READ_CALENDAR,                //读取日历中的日程信息
    READ_CALL_LOG,                 //读取通话记录
 
    READ_CONTACTS,               //读取联系人信息
    READ_EXTERNAL_STORAGE,       //读取设备上的照片及文件
    //READ_HISTORY_BOOKMARKS,     //Android目前已经不支持  Read history bookmarks (obsolete)
 
    READ_PHONE_NUMBERS,
    READ_PHONE_STATE,
    READ_SMS,
 
    RECEIVE_MMS,
    RECEIVE_SMS,
    RECEIVE_WAP_PUSH,
    RECORD_AUDIO,
 
    SEND_SMS,
    USE_SIP,
    WRITE_CALENDAR,
    WRITE_CALL_LOG,
    WRITE_CONTACTS,
    WRITE_EXTERNAL_STORAGE
 
                );
 
  TPermissions = set of TPermission;
 
 
  TAndroid_Permission = class(TComponent)
  private
    FOnApplyResult : TApplyResult;
    FPermissions   : TPermissions;
    FPermissionsStr: TArray<string>;
    procedure SetFPermissions(value: TPermissions);
    // **** 关于 Android 权限相关 ****
    procedure DisplayRationale(Sender: TObject; const APermissions: TClassicStringDynArray; const APostRationaleProc: TProc);
 
{$IF CompilerVersion >= 35.0}
    // after Delphi 11 Alexandria
    procedure AndroidPermissionRequestResult(Sender: TObject;
      const APermissions: TClassicStringDynArray;
      const AGrantResults: TClassicPermissionStatusDynArray);
{$ELSE}
    // before Delphi 11 Alexandria
    procedure AndroidPermissionRequestResult(const APermissions: TArray<string>;
      const AGrantResults: TArray<TPermissionStatus>);
{$ENDIF}
 
 
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    //申请权限
    procedure Apply;
    //检测权限是否已经授予
    function IsPermissionGranted(APermission : string): Boolean;
  published
    property Permissions: TPermissions read FPermissions write SetFPermissions;
    property OnApplyResult : TApplyResult read FOnApplyResult write FOnApplyResult;
  end;
 
//procedure Register;
 
implementation
 
//{$R 'Android_Permission.dcr'}
 
//procedure Register;
//begin
//  RegisterComponents('LW', [TAndroid_Permission]);
//end;
 
{ TAndroid_Permission }
 
{$IF CompilerVersion >= 35.0}
procedure TAndroid_Permission.AndroidPermissionRequestResult(Sender: TObject;
  const APermissions: TClassicStringDynArray;
  const AGrantResults: TClassicPermissionStatusDynArray);
var
  i,count : integer;
  NoGranteds : TArray<string>;
begin
  // 判断是否申请的授权都已经批准
  SetLength(NoGranteds,0);
  count := Length(FPermissionsStr);
 
  for i := 0 to count - 1 do    //逐条判断是否已经成功授权
    begin
    {$IFDEF DEBUG}
      showmessage(GetEnumName(typeInfo(TPermissionStatus), Ord(AGrantResults[i])) + ' : '#13#10 + FPermissionsStr[i]);
    {$ENDIF}
    if AGrantResults[i] <> TPermissionStatus.Granted then
       begin
         SetLength(NoGranteds,Length(NoGranteds) + 1);
         NoGranteds[Length(NoGranteds) - 1] := FPermissionsStr[i];
       end;
    end;
 
  if Length(NoGranteds) = 0 then
    begin
      if Assigned(FOnApplyResult) then     //此时授权已经全部成功，可以触发授权成功事件
         try
           FOnApplyResult(Self,True,[]);   //防止用户事件出错，导致控件错误
         except on E: Exception do
           raise Exception.Create('OnApplyResult: ' + E.message);
         end;
    end
  else
    if Assigned(FOnApplyResult) then     //此时授权已经全部成功，可以触发授权成功事件
       try
         FOnApplyResult(Self,False,NoGranteds);     //防止用户事件出错，导致控件错误
       except on E: Exception do
         raise Exception.Create('OnApplyResult: ' + E.message);
       end;
 
end;
{$ELSE}
procedure AndroidPermissionRequestResult(const APermissions: TArray<string>;
      const AGrantResults: TArray<TPermissionStatus>);
var
  i,count : integer;
  NoGranteds : TArray<string>;
begin
  // 判断是否申请的授权都已经批准
  SetLength(NoGranteds,0);
  count := Length(FPermissionsStr);
 
  for i := 0 to count - 1 do    //逐条判断是否已经成功授权
    begin
    if AGrantResults[i] <> TPermissionStatus.Granted then
       begin
         SetLength(NoGranteds,Length(NoGranteds) + 1);
         NoGranteds[Length(NoGranteds) - 1] := FPermissionsStr[i];
       end;
    end;
 
  if Length(NoGranteds) = 0 then
    begin
      if Assigned(FOnApplyResult) then     //此时授权已经全部成功，可以触发授权成功事件
        try
          FOnApplyResult(Self,True,[]);   //防止用户事件出错，导致控件错误
        except on E: Exception do
          raise Exception.Create('OnApplyResult: ' + E.message);
        end;
    end
  else
    if Assigned(FOnApplyResult) then     //此时授权已经全部成功，可以触发授权成功事件
      try
        FOnApplyResult(Self,False,NoGranteds);     //防止用户事件出错，导致控件错误
      except on E: Exception do
        raise Exception.Create('OnApplyResult: ' + E.message);
      end;
 
 
end;
 
{$ENDIF}
 
 
 
procedure TAndroid_Permission.Apply;
var
  Permission : TPermission;
  i : Integer;
  {$IFDEF DEBUG}
    count : integer;
    S : string;
  {$ENDIF}
  PermissionStr : string;
begin
  {$IFNDEF ANDROID}
     Exit;       //只有android 环境下动态申请权限才有效
  {$ENDIF}
  //确认只有 10.3 及以上的版本编译才有效
  {$IF CompilerVersion < 33.0}   //10.3 Rio
    Exit;  //10.3 以下不支持
  {$ELSE}
     if (TOSVersion.Major <= 6) then Exit;   //只有Android 7 以上才支持动态权限，实际上7没有反应，8才真正支持动态权限申请
  {$ENDIF}
 
  SetLength(FPermissionsStr,0);   //初始化当前权限数组
  //构造权限字符串数组,最大权限256个，目前是没有超过的
  for i := 0 to 255 do
    begin
      Permission := TPermission(i);
      if not (Permission in FPermissions) then continue;
      PermissionStr := GetEnumName(typeInfo(TPermission), i);
      if (PermissionStr = '') or (PermissionStr = 'uAndroid_Permissions_Component') then
        Break;
      //增加权限数组字符串
      SetLength(FPermissionsStr,Length(FPermissionsStr) + 1);
      FPermissionsStr[Length(FPermissionsStr) - 1] := Permission_Prefix + PermissionStr;
    end;
 
  //如果没有选择授权，则直接退出
  if Length(FPermissionsStr) = 0 then Exit;
  {$IFDEF DEBUG}
    count := Length(FPermissionsStr);
    S := '';
    for i := 0 to count - 1 do
       S := S + FPermissionsStr[i] + #13#10;
    ShowMessage(S) ;
  {$ENDIF}
 
  //申请权限
  PermissionsService.RequestPermissions
    (FPermissionsStr, AndroidPermissionRequestResult,
    DisplayRationale);
end;
 
constructor TAndroid_Permission.Create(AOwner: TComponent);
begin
  inherited;
end;
 
destructor TAndroid_Permission.Destroy;
begin
  inherited;
end;
 
procedure TAndroid_Permission.DisplayRationale(Sender: TObject;
  const APermissions: TClassicStringDynArray; const APostRationaleProc: TProc);
var
  I: Integer;
  RationaleMsg: string;
begin
  for I := 0 to High(APermissions) do
  begin
    if APermissions[I] = FPermissionsStr[i] then
      RationaleMsg := RationaleMsg +
        'App needs [' + FPermissionsStr[i] + '] Right' + SLineBreak +
        SLineBreak;
  end;
  // Show an explanation to the user *asynchronously* - don't block this thread waiting for the user's response!
  // After the user sees the explanation, invoke the post-rationale routine to request the permissions
  TDialogService.ShowMessage(RationaleMsg,
    procedure(const AResult: TModalResult)
    begin
      APostRationaleProc;
    end)
end;
 
function TAndroid_Permission.IsPermissionGranted(APermission: string): Boolean;
begin
  if Trim(APermission) = '' then Exit(False);
  try
    Result := PermissionsService.IsPermissionGranted(APermission);
  except on E: Exception do
    Result := False;
  end;
end;
 
 
procedure TAndroid_Permission.SetFPermissions(value: TPermissions);
begin
 FPermissions := value;
end;
 
end.

　使用：

var Android_Permission : TAndroid_Permission;

procedure TGPS.DoShow;
begin
  inherited;
  Android_Permission := TAndroid_Permission.Create(self);
  Android_Permission.Permissions := Android_Permission.Permissions + [ACCESS_COARSE_LOCATION, ACCESS_FINE_LOCATION];
  Android_Permission.Apply;
end;