unit Unit5;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, REST.Types, REST.Client,
  Data.Bind.Components, Data.Bind.ObjectScope, FMX.Edit, FMX.Controls.Presentation, FMX.StdCtrls,
  FMX.ScrollBox, FMX.Memo, FMX.Media, FMX.Objects, Uarcsoft_face_sdk, Uamcomdef, Umerror,
  FMX.Layouts, FMX.ExtCtrls, System.Math.Vectors, UniProvider, SQLiteUniProvider, Data.DB, DBAccess,
  Uni, MemDS, System.Rtti, FMX.Grid.Style, FMX.Bind.Grid, System.Bindings.Outputs, FMX.Bind.Editors,
  Data.Bind.EngExt, FMX.Bind.DBEngExt, Data.Bind.Grid, FMX.Grid, Data.Bind.DBScope;

type
  TForm5 = class(TForm)
    RESTClient1: TRESTClient;
    RESTRequest1: TRESTRequest;
    RESTResponse1: TRESTResponse;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    CameraComponent1: TCameraComponent;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Image1: TImage;
    imgCamera: TImage;
    Button8: TButton;
    UniConnection1: TUniConnection;
    SQLiteUniProvider1: TSQLiteUniProvider;
    UniQuery1: TUniQuery;
    Panel1: TPanel;
    DataSource1: TDataSource;
    StringGridBindSourceDB1: TStringGrid;
    Edit2: TEdit;
    GroupBox1: TGroupBox;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    BindSourceDB1: TBindSourceDB;
    LinkGridToDataSourceBindSourceDB1: TLinkGridToDataSource;
    BindingsList1: TBindingsList;
    Button15: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CameraComponent1SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
  private
    FSDKHandle: MHandle;
    procedure GetImage;
    procedure WriteLog(msg: String);
    function bitmapToRGBArray(Bitmap: FMX.Graphics.TBitmap): TBytes;
    function bitmapToGray(Bitmap: FMX.Graphics.TBitmap): TBytes;
    procedure InitDB();
    procedure FeatureCompare(feature: ASF_FaceFeature);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

uses
  System.DateUtils, IdHashMessageDigest, Uasvloffscreen
  {$IFDEF MSWINDOWS}
    , Winapi.Nb30, Winapi.Windows
  {$ENDIF}
  {$IFDEF LINUX}
    , Posix.Base, Posix.Fcntl
  {$ENDIF}, System.NetEncoding, System.IOUtils, System.IniFiles;

const
  Max_Face = 5;

  {$R *.fmx}

function md5(s: string): string; overload;
var
  md5: TIdHashMessageDigest5;
begin
  md5 := TIdHashMessageDigest5.Create;
  try

    Result := LowerCase(md5.HashStringAsHex(s));
  finally
    md5.Free;
  end;
end;

function md5(s: string; L: integer): string; overload;
begin
  Result := Copy(md5(s), 5, L);
end;

{$IFDEF MSWINDOWS}

function GetMacPhysicalAddress(Alana: integer = 0): string; overload;
var
  NCB: TNCB; // Netbios控制块
  AdapterStatus: TAdapterStatus; // 取网卡状态
  LanaEnum: TLanaEnum; // LANA枚举值
  I: integer;
begin
  Result := '';
  Try
    { http://blog.csdn.net/sushengmiyan/article/details/8543811
      一、枚举LANA值
      ①.申请分配一个TNCB结构           NCB: TNCB；
      ②.将TNCB结构变量初始化成O        ZeroMemory(@NCB , SizeOf(NCB));
      ③.置命令为NCBENUM                NCB.ncb_Command := chr(NCBENUM);
      ④.为ncb_buffer分配LANA_ENUM      NCB.ncb_buffer := @LANAENUM;
      ⑤.为NCB_length制定长度           NCB.NCB_length := Sizeof(LANAENUM);
      ⑥.调用Netbios函数获取Netbios     CRC := NetBios(@NCB);
      ⑦.返回值NRC_GOODRET表示成功      NCB.ncb_retcode = Chr(NRC_GOODRET)
    }
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_Command := Chr(NCBENUM);
    NCB.ncb_buffer := @LanaEnum;
    NCB.NCB_length := SizeOf(LanaEnum);
    NetBios(@NCB);
    if not(NCB.ncb_retcode = Chr(NRC_GOODRET)) then
      Exit;

    { http://blog.csdn.net/sushengmiyan/article/details/8543811
      二、重置计划使用的每个LANA编号
      ①.申请分配一个TNCB结构           NCB: TNCB；
      ②.将TNCB结构变量初始化成O        ZeroMemory(@NCB , SizeOf(NCB));
      ③.置命令为NCBRESET               NCB.ncb_Command := chr(NCBRESET);
      ④.给命令设置LANA编号             NCB.ncb_lana_num := LanaEnum.lana[Alana];
      ⑤.调用Netbios函数获取Netbios     CRC := NetBios(@NCB);
      ⑥.返回值NRC_GOODRET表示成功      NCB.ncb_retcode = Chr(NRC_GOODRET)
    }
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_Command := Chr(NCBRESET);
    NCB.ncb_lana_num := LanaEnum.lana[Alana];
    NetBios(@NCB);
    if not(NCB.ncb_retcode = Chr(NRC_GOODRET)) then
      Exit;

    { http://blog.csdn.net/sushengmiyan/article/details/8543811
      三、使用TAdapterStatus结构获取网卡地址
      ①.申请分配一个TNCB结构           NCB: TNCB；
      ②.将TNCB结构变量初始化成O        ZeroMemory(@NCB , SizeOf(NCB));
      ③.置命令为NCBASTAT               NCB.ncb_Command := chr(NCBASTAT);
      ④.为ncb_buffer分配LANA_ENUM      NCB.ncb_buffer := @LANAENUM;
      ⑤.设置ncb_callname               NCB.ncb_callname := '* ' + #0;
      ⑥.为ncb_buffer分配AdapterStatus  NCB.ncb_buffer := @AdapterStatus;
      ⑦.为NCB_length制定长度           NCB.NCB_length := Sizeof(AdapterStatus);
      ⑧.调用Netbios函数获取Netbios     CRC := NetBios(@NCB);
    }
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_Command := Chr(NCBASTAT);
    NCB.ncb_lana_num := LanaEnum.lana[Alana];
    NCB.ncb_callname[0] := '*';
    // 不明白为何如此设置，*代表啥子？
    // 有懂的可以邮件分享 429119108@qq.com   O(∩_∩)O谢谢
    NCB.ncb_buffer := @AdapterStatus;
    NCB.NCB_length := SizeOf(AdapterStatus);
    NetBios(@NCB);

    // 获取形如AA-BB-CC-DD-EE-FF形式的mac物理地址字符串
    for I := 0 to 5 do
      Result := Result + IntToHex(integer(AdapterStatus.adapter_address[I]), 2)

  Finally

  End;
end;
{$ENDIF}
{$IFDEF LINUX}

type
  TStreamHandle = pointer;
  TAlanaName = (eth0, wlan0);

function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle;
  cdecl; external libc name _PU + 'popen';
function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
function fgets(buffer: pointer; size: int32; Stream: TStreamHandle): pointer; cdecl;
  external libc name _PU + 'fgets';

function runCommand(const acommand: MarshaledAString): String;
// run a linux shell command and return output
// Adapted from http://chapmanworld.com/2017/04/06/calling-linux-commands-from-delphi/
var
  handle: TStreamHandle;
  Data: array [0 .. 511] of uint8;

  function bufferToString(buffer: pointer; maxSize: uint32): string;
  var
    cursor: ^uint8;
    endOfBuffer: nativeuint;
  begin
    if not assigned(buffer) then
      Exit;
    cursor := buffer;
    endOfBuffer := nativeuint(cursor) + maxSize;
    while (nativeuint(cursor) < endOfBuffer) and (cursor^ <> 0) do
    begin
      Result := Result + Chr(cursor^);
      cursor := pointer(succ(nativeuint(cursor)));
    end;
  end;

begin
  Result := '';
  handle := popen(acommand, 'r');
  try
    while fgets(@Data[0], SizeOf(Data), handle) <> nil do
    begin
      Result := Result + bufferToString(@Data[0], SizeOf(Data));
    end;
  finally
    pclose(handle);
  end;
end;

function GetMacPhysicalAddress(Alana: TAlanaName = eth0): string; overload;
const
  C_CMD: array [TAlanaName] of String = ('cat /sys/class/net/eth0/address',
    'cat /sys/class/net/wlan0/address');
var
  cmd: AnsiString;
begin
  cmd := C_CMD[Alana];
  Result := runCommand(MarshaledAString(cmd));

  if (Result = '') then
  begin
    cmd := C_CMD[TAlanaName.wlan0];
    Result := runCommand(MarshaledAString(cmd));
  end;

  Result := UpperCase(StringReplace(Result, ':', '', [rfReplaceAll]));
end;
{$ENDIF}

procedure mirrorBitmap(Bitmap: FMX.Graphics.TBitmap);
var
  src, dest: TRectF;
  bmp: FMX.Graphics.TBitmap;
  w, h: integer;
begin

  w := Bitmap.Width;
  h := Bitmap.Height;
  dest := Bounds(0, 0, w, h);
  src := Rect(w, 0, 0, h);

  bmp := FMX.Graphics.TBitmap.Create;
  try
    bmp.SetSize(w, h);
    bmp.Canvas.DrawBitmap(Bitmap, src, dest, 255, True);
    Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

function getUniqueCode(): String;
begin
  Result := GetMacPhysicalAddress();
end;

procedure TForm5.InitDB;
begin
  try
    self.UniQuery1.SQL.Text := 'CREATE TABLE IF NOT EXISTS Faces' + #13#10 +
      '("id" integer PRIMARY KEY AUTOINCREMENT,' + #13#10 + '"faceName" text(50),' + #13#10 +
      '"feature" text(2000),"featureSize" integer)';
    self.UniQuery1.ExecSQL;

    self.UniQuery1.SQL.Text := 'select *  From Faces';
    self.UniQuery1.ExecSQL;

  except
    on E: Exception do
      self.WriteLog('初始化数据库出错：' + E.Message);
  end;
end;

procedure TForm5.WriteLog(msg: String);
begin
  msg := DatetimeToStr(now()) + #9 + msg;
  self.Memo1.Lines.Add(msg);
end;

procedure TForm5.Button10Click(Sender: TObject);
var
  imgData: TBytes;
  I: integer;
begin
  if not self.imgCamera.Bitmap.IsEmpty then
  begin
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);
  end;
  imgData := self.bitmapToGray(self.Image1.Bitmap);
  for I := Low(imgData) to High(imgData) do
  begin
    if (I mod 1024 = 0) then
      self.WriteLog(Format(' X:%d,value:%d', [I, imgData[I]]));
  end;
end;

procedure TForm5.Button11Click(Sender: TObject);
var
  rgbLivenessInfo: ASF_LivenessInfo;
  res: MRESULT;
  threshold: ASF_LivenessThreshold;
  processMask: MInt32;
  imgData: TBytes;
  grayData: TBytes;

  detectedFaces: ASF_MultiFaceInfo;
  SingleDetectedFaces1: ASF_SingleFaceInfo;
  feature1: ASF_FaceFeature;
  I: integer;
  myRect: TRect;
  faceRect: PMRECT;
begin
  if (not self.CameraComponent1.Active) or (self.imgCamera.Bitmap.IsEmpty) then
  begin
    self.WriteLog('摄像未打开！');
    Exit;
  end;

  if (FSDKHandle <> nil) then
  begin
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);
    imgData := self.bitmapToRGBArray(self.Image1.Bitmap);

    grayData := self.bitmapToGray(self.Image1.Bitmap);

    self.WriteLog(Format(' PixelFormat:GBRA(4) %d', [ord(Image1.Bitmap.PixelFormat)]));

    res := ASFDetectFaces(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
      ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces);

    if (MOK = res) then
    begin

      self.WriteLog(Format(' ASFDetectFaces  : %d', [detectedFaces.faceNum]));
      if (detectedFaces.faceNum > 0) then
      begin
        faceRect := detectedFaces.faceRect;
        SingleDetectedFaces1.faceRect := detectedFaces.faceRect^;
        SingleDetectedFaces1.faceOrient := detectedFaces.faceOrient^;

        feature1.feature := nil;
        feature1.featureSize := 0;

        for I := 0 to detectedFaces.faceNum - 1 do
        begin
          with self.Image1.Bitmap do
          begin
            // Left, Top, Right, Bottom
            // myRect := TRect.Create(faceRect^.Left, faceRect^.Top, faceRect^.Right,
            // faceRect^.Bottom);
            myRect := faceRect^;

            self.WriteLog(Format(' faceRect Left:%d,Top:%d,Right:%d,Bottom:%d',
              [myRect.Left, myRect.Top, myRect.Right, myRect.Bottom]));

            Canvas.BeginScene();
            Canvas.Stroke.Kind := TBrushKind.bkSolid;
            Canvas.Stroke.Color := TAlphaColors.red;
            Canvas.Stroke.Thickness := 5;

            Canvas.DrawRect(myRect, 0, 0, AllCorners, 255);
            Canvas.EndScene;

            inc(faceRect);
          end;
        end;

        // 设置活体置信度 SDK内部默认值为 IR：0.7  RGB：0.75（无特殊需要，可以不设置）

        threshold.thresholdmodel_BGR := 0.75;
        threshold.thresholdmodel_IR := 0.5;
        res := ASFSetLivenessParam(FSDKHandle, @threshold);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFSetLivenessParam fail: %d', [res]))
        else
          self.WriteLog(Format(' RGB Threshold: %f  IR Threshold: %f',
            [threshold.thresholdmodel_BGR, threshold.thresholdmodel_IR]));

        // IR图像活体检测
        processMask := ASF_IR_LIVENESS;
        res := ASFProcess_IR(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height, ASVL_PAF_GRAY,
          @grayData[0], @detectedFaces, processMask);;
        if (res <> MOK) then
          self.WriteLog(Format(' ASFProcess fail: %d', [res]))
        else
          self.WriteLog(Format(' ASFProcess sucess: %d', [res]));

        // 获取RGB活体信息

        res := ASFGetLivenessScore_IR(FSDKHandle, @rgbLivenessInfo);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFGetLivenessScore_IR fail: %d', [res]))
        else
          self.WriteLog(Format(' IR Liveness(真人:1): %d', [rgbLivenessInfo.isLive^]));

      end;

    end
    else
      self.WriteLog(Format(' ASFDetectFaces  fail: %d', [res]));

  end;

end;

procedure TForm5.Button12Click(Sender: TObject);
var
  res: MRESULT;
  detectedFaces: ASF_MultiFaceInfo;
  SingleDetectedFaces1: ASF_SingleFaceInfo;
  feature1: ASF_FaceFeature;
  I: integer;
  imgData: TBytes;
  myRect: TRect;
  faceRect: PMRECT;
begin
  if (not self.CameraComponent1.Active) or (self.imgCamera.Bitmap.IsEmpty) then
  begin
    self.WriteLog('摄像未打开！');
    Exit;
  end;

  if (FSDKHandle <> nil) then
  begin
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);

    imgData := self.bitmapToRGBArray(Image1.Bitmap);

    self.WriteLog(Format(' PixelFormat:GBRA(4) %d', [ord(Image1.Bitmap.PixelFormat)]));

    res := ASFDetectFaces(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
      ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces);

    if (MOK = res) then
    begin

      self.WriteLog(Format(' ASFDetectFaces  : %d', [detectedFaces.faceNum]));
      if (detectedFaces.faceNum > 0) then
      begin
        faceRect := detectedFaces.faceRect;
        SingleDetectedFaces1.faceRect := detectedFaces.faceRect^;
        SingleDetectedFaces1.faceOrient := detectedFaces.faceOrient^;

        for I := 0 to detectedFaces.faceNum - 1 do
        begin
          with self.Image1.Bitmap do
          begin
            // Left, Top, Right, Bottom
            // myRect := TRect.Create(faceRect^.Left, faceRect^.Top, faceRect^.Right,
            // faceRect^.Bottom);
            myRect := faceRect^;

            self.WriteLog(Format(' faceRect Left:%d,Top:%d,Right:%d,Bottom:%d',
              [myRect.Left, myRect.Top, myRect.Right, myRect.Bottom]));

            Canvas.BeginScene();
            Canvas.Stroke.Kind := TBrushKind.bkSolid;
            Canvas.Stroke.Color := TAlphaColors.red;
            Canvas.Stroke.Thickness := 5;

            Canvas.DrawRect(myRect, 0, 0, AllCorners, 255);
            Canvas.EndScene;

            inc(faceRect);
          end;

        end;

        feature1.feature := nil;
        feature1.featureSize := 0;

        res := ASFFaceFeatureExtract(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
          ASVL_PAF_RGB24_B8G8R8, @imgData[0], @SingleDetectedFaces1, @feature1);
        if (res = MOK) and (assigned(feature1.feature)) then
        begin
          // 比对
          self.FeatureCompare(feature1)
        end
        else
          self.WriteLog(Format(' ASFFaceFeatureExtract 1 fail: %d', [res]));
      end;

    end
    else
      self.WriteLog(Format(' ASFDetectFaces  fail: %d', [res]));

  end;
end;

procedure TForm5.Button13Click(Sender: TObject);
var
  I: integer;
  iTime: Int64;
begin
  iTime := DateTimeToMilliseconds(now());
  for I := 0 to 1000 do
  begin
    with self.UniQuery1 do
    begin
      self.StringGridBindSourceDB1.BeginUpdate;
      try
        Append;
        FieldByName('faceName').AsString := 'Test' + IntToStr(I);
        FieldByName('feature').AsString := 'Test' + IntToStr(I);
        FieldByName('featureSize').AsInteger := I;
        post;

        Sleep(5);
      finally
        self.StringGridBindSourceDB1.EndUpdate;
      end;

    end;
  end;

  self.WriteLog(Format('用时:%d', [DateTimeToMilliseconds(now()) - iTime]));
end;

procedure TForm5.Button14Click(Sender: TObject);
var
  iTime: Int64;
begin
  iTime := DateTimeToMilliseconds(now());
  with self.UniQuery1 do
  begin
    First;
    while not Eof do
    begin
      self.WriteLog(Format('F1:%d,F2:%s,F3:%s,F4:%d', [FieldByName('id').AsInteger,
        FieldByName('faceName').AsString, FieldByName('feature').AsString,
        FieldByName('featureSize').AsInteger]));
      Sleep(5);
      Next;
    end;
  end;
  self.WriteLog(Format('用时:%d', [DateTimeToMilliseconds(now()) - iTime]));
end;

procedure TForm5.Button15Click(Sender: TObject);
begin
  if not self.imgCamera.Bitmap.IsEmpty then
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);
  mirrorBitmap(self.Image1.Bitmap);
end;

procedure TForm5.Button1Click(Sender: TObject);
begin
  self.WriteLog('UniqueCode= ' + getUniqueCode());
end;

procedure TForm5.Button3Click(Sender: TObject);
begin
  self.CameraComponent1.Active := True;
end;

procedure TForm5.Button4Click(Sender: TObject);
var
  res: MRESULT;
  APPID, SDKKey: AnsiString;
  activeFileInfo: ASF_ActiveFileInfo;
  IniFile: TIniFile;
begin
  // 激活接口,需联网激活
  IniFile := TIniFile.Create('./SDKKey.ini');
  try
    APPID := IniFile.ReadString('AppInfo', 'APPID', '');
    SDKKey := IniFile.ReadString('AppInfo', 'SDKKey', '');
    self.WriteLog(Format('加载AppID:[%s],SDKKey:[%s]', [APPID, SDKKey]));
  finally
    IniFile.Free;
  end;

  res := ASFOnlineActivation(MPchar(APPID), MPchar(SDKKey));
  if (MOK <> res) and (MERR_ASF_ALREADY_ACTIVATED <> res) then
    self.WriteLog(Format('ASFActivation fail: %d', [res]))
  else
    self.WriteLog(Format(' ASFActivation sucess: %d', [res]));

  // 获取激活文件信息
  res := ASFGetActiveFileInfo(@activeFileInfo);
  if (res <> MOK) then
    self.WriteLog(Format(' ASFGetActiveFileInfo fail: %d', [res]));
end;

procedure TForm5.Button5Click(Sender: TObject);
var

  mask: MInt32;
  res: MRESULT;
begin
  // 初始化接口
  mask := ASF_FACE_DETECT or ASF_FACERECOGNITION or ASF_AGE or ASF_GENDER or ASF_FACE3DANGLE or
    ASF_LIVENESS or ASF_IR_LIVENESS;
  res := ASFInitEngine(ASF_DETECT_MODE_IMAGE, ASF_OP_0_ONLY, 30, Max_Face, mask, @FSDKHandle);
  if (res <> MOK) then
    self.WriteLog(Format(' ASFInitEngine fail: %d', [res]))
  else
    self.WriteLog(Format(' ASFInitEngine sucess: %d', [res]));
end;

procedure TForm5.Button6Click(Sender: TObject);
var
  res: MRESULT;
  detectedFaces: ASF_MultiFaceInfo;
  SingleDetectedFaces1: ASF_SingleFaceInfo;
  feature1: ASF_FaceFeature;
  I: integer;
  imgData: TBytes;
  myRect: TRect;
  faceRect: PMRECT;
begin
  if (not self.CameraComponent1.Active) or (self.imgCamera.Bitmap.IsEmpty) then
  begin
    self.WriteLog('摄像未打开！');
    Exit;
  end;

  if (FSDKHandle <> nil) then
  begin
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);

    imgData := self.bitmapToRGBArray(Image1.Bitmap);

    self.WriteLog(Format(' PixelFormat:GBRA(4) %d', [ord(Image1.Bitmap.PixelFormat)]));

    res := ASFDetectFaces(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
      ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces);

    if (MOK = res) then
    begin

      self.WriteLog(Format(' ASFDetectFaces  : %d', [detectedFaces.faceNum]));
      if (detectedFaces.faceNum > 0) then
      begin
        faceRect := detectedFaces.faceRect;
        SingleDetectedFaces1.faceRect := detectedFaces.faceRect^;
        SingleDetectedFaces1.faceOrient := detectedFaces.faceOrient^;

        feature1.feature := nil;
        feature1.featureSize := 0;

        for I := 0 to detectedFaces.faceNum - 1 do
        begin
          with self.Image1.Bitmap do
          begin
            // Left, Top, Right, Bottom
            // myRect := TRect.Create(faceRect^.Left, faceRect^.Top, faceRect^.Right,
            // faceRect^.Bottom);
            myRect := faceRect^;

            self.WriteLog(Format(' faceRect Left:%d,Top:%d,Right:%d,Bottom:%d',
              [myRect.Left, myRect.Top, myRect.Right, myRect.Bottom]));

            Canvas.BeginScene();
            Canvas.Stroke.Kind := TBrushKind.bkSolid;
            Canvas.Stroke.Color := TAlphaColors.red;
            Canvas.Stroke.Thickness := 5;

            Canvas.DrawRect(myRect, 0, 0, AllCorners, 255);
            Canvas.EndScene;

            inc(faceRect);
          end;

        end;
      end;

    end
    else
      self.WriteLog(Format(' ASFDetectFaces  fail: %d', [res]));

  end;
end;

procedure TForm5.Button7Click(Sender: TObject);
var

  myRect: TRectF;
begin
  with self.Image1.Bitmap do
  begin
    Canvas.BeginScene(); // 这个要放第一

    myRect := TRectF.Create(40, 120, 200, 450);
    // 画笔的宽度
    Canvas.Stroke.Thickness := 5.0;
    // 画笔画刷
    Canvas.Stroke.Kind := TBrushKind.Solid;
    // 颜色
    Canvas.Stroke.Color := TAlphaColors.Blue;
    // 线端点现状
    Canvas.Stroke.Cap := TStrokeCap.Round;
    // 画笔的线形
    Canvas.Stroke.Dash := TStrokeDash.Dot;
    // 线连接形式
    Canvas.Stroke.Join := TStrokeJoin.Round;
    //
    // Canvas.Fill.Color := oStyle.FillColor;
    // Canvas.Font.Size := oStyle.FontSize;
    // Canvas.Font.Style := [];

    Canvas.DrawEllipse(myRect, 255);
    Canvas.DrawRect(myRect, 30, 30, AllCorners, 1);
    Canvas.EndScene;
  end;

end;

procedure TForm5.Button8Click(Sender: TObject);
var
  res: MRESULT;
  detectedFaces: ASF_MultiFaceInfo;
  SingleDetectedFaces: ASF_SingleFaceInfo;
  feature: ASF_FaceFeature;
  I: integer;
  imgData: TBytes;
  myRect: TRect;
  faceRect: PMRECT;
  featureStr: String;
begin
  if (not self.CameraComponent1.Active) or (self.imgCamera.Bitmap.IsEmpty) then
  begin
    self.WriteLog('摄像未打开！');
    Exit;
  end;

  if (FSDKHandle <> nil) then
  begin

    self.Image1.Width := self.imgCamera.Width;
    self.Image1.Height := self.imgCamera.Height;
    self.WriteLog(Format(' Image1 Width:%f,Height:%f', [self.Image1.Width, self.Image1.Height]));

    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);

    imgData := self.bitmapToRGBArray(Image1.Bitmap);

    self.WriteLog(Format(' PixelFormat:GBRA(4) %d', [ord(Image1.Bitmap.PixelFormat)]));

    res := ASFDetectFaces(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
      ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces);

    if (MOK = res) then
    begin

      self.WriteLog(Format(' ASFDetectFaces  : %d', [detectedFaces.faceNum]));
      if (detectedFaces.faceNum > 0) then
      begin
        faceRect := detectedFaces.faceRect;
        SingleDetectedFaces.faceRect := detectedFaces.faceRect^;
        SingleDetectedFaces.faceOrient := detectedFaces.faceOrient^;

        feature.feature := nil;
        feature.featureSize := 0;

        for I := 0 to detectedFaces.faceNum - 1 do
        begin
          with self.Image1.Bitmap do
          begin
            // Left, Top, Right, Bottom
            // myRect := TRect.Create(faceRect^.Left, faceRect^.Top, faceRect^.Right,
            // faceRect^.Bottom);
            myRect := faceRect^;

            self.WriteLog(Format(' faceRect Left:%d,Top:%d,Right:%d,Bottom:%d',
              [myRect.Left, myRect.Top, myRect.Right, myRect.Bottom]));

            Canvas.BeginScene();
            Canvas.Stroke.Kind := TBrushKind.bkSolid;
            Canvas.Stroke.Color := TAlphaColors.red;
            Canvas.Stroke.Thickness := 5;

            Canvas.DrawRect(myRect, 0, 0, AllCorners, 255);
            Canvas.EndScene;

            inc(faceRect);
          end;
        end;

        res := ASFFaceFeatureExtract(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
          ASVL_PAF_RGB24_B8G8R8, @imgData[0], @SingleDetectedFaces, @feature);
        if (MOK = res) then
        begin
          if feature.featureSize > 0 then
          begin
            featureStr := TNetEncoding.Base64.EncodeBytesToString(feature.feature,
              feature.featureSize);

            self.WriteLog(Format('featureSize:%d', [feature.featureSize]));

            self.UniQuery1.Append;
            self.UniQuery1.FieldByName('faceName').AsString := self.Edit2.Text;
            self.UniQuery1.FieldByName('feature').AsString := featureStr;
            self.UniQuery1.FieldByName('featureSize').AsInteger := feature.featureSize;

            self.UniQuery1.post;

            self.WriteLog('成功提取到特征!');

          end;
        end
        else
          self.WriteLog(Format(' ASFFaceFeatureExtract  fail: %d', [res]))

      end;

    end
    else
      self.WriteLog(Format(' ASFDetectFaces  fail: %d', [res]));

  end;
end;

procedure TForm5.Button9Click(Sender: TObject);
var
  rgbLivenessInfo: ASF_LivenessInfo;
  res: MRESULT;
  threshold: ASF_LivenessThreshold;
  processMask: MInt32;
  imgData: TBytes;

  detectedFaces: ASF_MultiFaceInfo;
  SingleDetectedFaces1: ASF_SingleFaceInfo;
  feature1: ASF_FaceFeature;
  I: integer;
  myRect: TRect;
  faceRect: PMRECT;
  ageInfo: ASF_AgeInfo;
  genderInfo: ASF_GenderInfo;
  angleInfo: tag_ASF_Face3DAngle;
begin
  if (not self.CameraComponent1.Active) or (self.imgCamera.Bitmap.IsEmpty) then
  begin
    self.WriteLog('摄像未打开！');
    Exit;
  end;

  if (FSDKHandle <> nil) then
  begin
    self.Image1.Bitmap.Assign(self.imgCamera.Bitmap);

    imgData := self.bitmapToRGBArray(Image1.Bitmap);

    self.WriteLog(Format(' PixelFormat:GBRA(4) %d', [ord(Image1.Bitmap.PixelFormat)]));

    res := ASFDetectFaces(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
      ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces);

    if (MOK = res) then
    begin

      self.WriteLog(Format(' ASFDetectFaces  : %d', [detectedFaces.faceNum]));
      if (detectedFaces.faceNum > 0) then
      begin
        faceRect := detectedFaces.faceRect;
        SingleDetectedFaces1.faceRect := detectedFaces.faceRect^;
        SingleDetectedFaces1.faceOrient := detectedFaces.faceOrient^;

        feature1.feature := nil;
        feature1.featureSize := 0;

        for I := 0 to detectedFaces.faceNum - 1 do
        begin
          with self.Image1.Bitmap do
          begin
            // Left, Top, Right, Bottom
            // myRect := TRect.Create(faceRect^.Left, faceRect^.Top, faceRect^.Right,
            // faceRect^.Bottom);
            myRect := faceRect^;

            self.WriteLog(Format(' faceRect Left:%d,Top:%d,Right:%d,Bottom:%d',
              [myRect.Left, myRect.Top, myRect.Right, myRect.Bottom]));

            Canvas.BeginScene();
            Canvas.Stroke.Kind := TBrushKind.bkSolid;
            Canvas.Stroke.Color := TAlphaColors.red;
            Canvas.Stroke.Thickness := 5;

            Canvas.DrawRect(myRect, 0, 0, AllCorners, 255);
            Canvas.EndScene;

            inc(faceRect);
          end;
        end;



        // 设置活体置信度 SDK内部默认值为 IR：0.7  RGB：0.75（无特殊需要，可以不设置）

        threshold.thresholdmodel_BGR := 0.75;
        threshold.thresholdmodel_IR := 0.7;
        res := ASFSetLivenessParam(FSDKHandle, @threshold);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFSetLivenessParam fail: %d', [res]))
        else
          self.WriteLog(Format(' RGB Threshold: %f  IR Threshold: %f',
            [threshold.thresholdmodel_BGR, threshold.thresholdmodel_IR]));

        // RGB图像属性检测
        processMask := ASF_AGE or ASF_GENDER or ASF_FACE3DANGLE or ASF_LIVENESS;
        res := ASFProcess(FSDKHandle, Image1.Bitmap.Width, Image1.Bitmap.Height,
          ASVL_PAF_RGB24_B8G8R8, @imgData[0], @detectedFaces, processMask);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFProcess fail: %d\', [res]))
        else
          self.WriteLog(Format(' ASFProcess sucess: %d', [res]));

        // 获取年龄
        res := ASFGetAge(FSDKHandle, @ageInfo);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFGetAge fail: %d', [res]))
        else
          self.WriteLog(Format(' Age: %d', [ageInfo.ageArray^]));

        // 获取性别
        res := ASFGetGender(FSDKHandle, @genderInfo);
        if (res <> MOK) then
          self.WriteLog(Format('ASFGetGender fail: %d', [res]))
        else
          self.WriteLog(Format('Gender: %d', [genderInfo.genderArray^]));

        // 获取3D角度

        res := ASFGetFace3DAngle(FSDKHandle, @angleInfo);
        if (res <> MOK) then
          self.WriteLog(Format('ASFGetFace3DAngle fail: %d', [res]))
        else
          self.WriteLog(Format('3DAngle roll: %f   yaw: %f   pitch: %f',
            [angleInfo.roll^, angleInfo.yaw^, angleInfo.pitch^]));

        // 获取RGB活体信息

        res := ASFGetLivenessScore(FSDKHandle, @rgbLivenessInfo);
        if (res <> MOK) then
          self.WriteLog(Format(' ASFGetLivenessScore fail: %d', [res]))
        else
          self.WriteLog(Format(' RGB Liveness(真人:1): %d', [rgbLivenessInfo.isLive^]));

      end;

    end
    else
      self.WriteLog(Format(' ASFDetectFaces  fail: %d', [res]));

  end;

end;

procedure TForm5.CameraComponent1SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  TThread.Synchronize(TThread.CurrentThread, GetImage);
  // hsz
end;

procedure TForm5.FeatureCompare(feature: ASF_FaceFeature);
var
  confidenceLevel: MFloat;
  res: MRESULT;
  feature2: ASF_FaceFeature;
  arr: TBytes;
begin

  // 单人脸特征比对
  if (FSDKHandle <> nil) then
  begin
    self.UniQuery1.First;
    while not self.UniQuery1.Eof do
    begin
      feature2.featureSize := self.UniQuery1.FieldByName('featureSize').AsInteger;
      SetLength(arr, feature2.featureSize);
      arr := TNetEncoding.Base64.DecodeStringToBytes(self.UniQuery1.FieldByName('feature')
        .AsString);
      feature2.feature := @arr[0];

      res := ASFFaceFeatureCompare(FSDKHandle, @feature, @feature2, @confidenceLevel);
      if (res <> MOK) then
      begin
        self.WriteLog(Format('  ASFFaceFeatureCompare fail: %d', [res]));
      end
      else
        self.WriteLog(Format('ASFFaceFeatureCompare [%s] sucess: %f',
          [self.UniQuery1.FieldByName('faceName').AsString, confidenceLevel]));

      self.UniQuery1.Next;
    end;
  end;
end;

procedure TForm5.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
begin
  // 激活接口,需联网激活
  if not FileExists('./SDKKey.ini') then
  begin
    IniFile := TIniFile.Create('./SDKKey.ini');
    try
      IniFile.WriteString('AppInfo', 'APPID', '注册虹软取得');
      IniFile.WriteString('AppInfo', 'SDKKey', '注册虹软取得');
    finally
      IniFile.Free;
    end;
  end;
  self.InitDB;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
  if (assigned(FSDKHandle)) then
  begin
    ASFUninitEngine(FSDKHandle);
  end;
end;

function TForm5.bitmapToGray(Bitmap: FMX.Graphics.TBitmap): TBytes;
var
  X: integer;
  Y: integer;
  A_BMPData: TBitmapData;
  Color: TAlphaColor;
  grayColor: TAlphaColor;
  grayColors: TAlphaColors;
  colors: TAlphaColorF;
  avg: Single;
  imageSize: Int64;
  w: Int64;

  str: String;
begin
  // 一个点RGB
  if not(assigned(Bitmap)) then
  begin
    Exit;
  end;

  imageSize := Bitmap.Width * Bitmap.Height;
  w := Bitmap.Width;
  SetLength(Result, imageSize);

  // PixelFormat 格式的问题  RGBA 但是无法设置成 RGB 他这个是只读属性
  // 所以在计算的时候 x*4
  if Bitmap.Map(TMapAccess.ReadWrite, A_BMPData) then
  begin

    for Y := 0 to A_BMPData.Height - 1 do
    begin
      for X := 0 to A_BMPData.Width - 1 do
      begin
        Color := A_BMPData.GetPixel(X, Y);

        colors := TAlphaColorF.Create(Color);

        // grayColors := TAlphaColors.Create(Color);
        // str := str + Format('R:%f,G:%f,B:%f,A:%f'#13#10, [colors.R, colors.G, colors.B, colors.A]);

        // avg := (colors.R * 299 + colors.G * 587 + colors.B * 114 + 500) / 1000;
        // avg := trunc(colors.R * 28 + colors.G * 151 + colors.B * 77) shr 8;
        avg := (colors.R + colors.G + colors.B) / 3;
        Result[X + Y * w] := Trunc(avg * 256);
        // str := str + Format(' avg:%d'#13#10, [Trunc(avg)]);

        grayColor := TAlphaColorF.Create(avg, avg, avg, colors.A).ToAlphaColor;

        A_BMPData.SetPixel(X, Y, grayColor);
      end;
    end;
    Bitmap.Unmap(A_BMPData);
  end;
  // self.WriteLog(str);
end;

function TForm5.bitmapToRGBArray(Bitmap: FMX.Graphics.TBitmap): TBytes;
var
  X: integer;
  Y: integer;
  A_BMPData: TBitmapData;
  Color: TAlphaColor;
  colors: TAlphaColors;
  imageSize: Int64;
  w: Int64;
begin
  // 一个点RGB
  if not(assigned(Bitmap)) then
  begin
    Exit;
  end;
  self.WriteLog(Format(' Bitmap  w: %d, h: %d', [Bitmap.Width, Bitmap.Height]));
  imageSize := Bitmap.Width * Bitmap.Height;
  w := Bitmap.Width;

  SetLength(Result, imageSize * 3);

  // PixelFormat 格式的问题  RGBA 但是无法设置成 RGB 他这个是只读属性
  // 所以在计算的时候 x*4
  if Bitmap.Map(TMapAccess.Read, A_BMPData) then
  begin

    for Y := 0 to A_BMPData.Height - 1 do
    begin
      for X := 0 to A_BMPData.Width - 1 do
      begin
        Color := A_BMPData.GetPixel(X, Y);
        colors := TAlphaColors.Create(Color);

        Result[(X + Y * w) * 3] := colors.R;
        Result[(X + Y * w) * 3 + 1] := colors.G;
        Result[(X + Y * w) * 3 + 2] := colors.B;

        // Result[X + Y * w + imageSize * 0] := colors.R;
        // Result[X + Y * w + imageSize * 1] := colors.G;
        // Result[X + Y * w + imageSize * 2] := colors.B;
      end;
    end;
    Bitmap.Unmap(A_BMPData);
  end;

end;

procedure TForm5.GetImage;
begin
  CameraComponent1.SampleBufferToBitmap(self.imgCamera.Bitmap, True);
  if self.CheckBox1.IsChecked then
  begin
    mirrorBitmap(self.imgCamera.Bitmap);
  end;
  // hsz
end;

end.