{*******************************************************}
{                                                       }
{       Tocsg.Bluetooth                                 }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.Bluetooth;

interface

uses
  EM.jwabluetoothapis, Tocsg.Obj, Tocsg.Thread, System.Classes,
  System.SysUtils, Winapi.Windows, System.Generics.Collections;

const
  BT_DEVICE_CLASS_MISC           = $0;
  BT_DEVICE_CLASS_COMPUTER       = $1;
  BT_DEVICE_CLASS_PHONE          = $2;
  BT_DEVICE_CLASS_LANACCESSPOINT = $3;
  BT_DEVICE_CLASS_AV             = $4;
  BT_DEVICE_CLASS_PERIPHERAL     = $5;
  BT_DEVICE_CLASS_IMAGING        = $6;
  BT_DEVICE_CLASS_UNCLASSIFIED   = $1F;

type
  PBtDevEnt = ^TBtDevEnt;
  TBtDevEnt = record
    sAddress: String;
    dtLastSeen,
    dtLastUsed: TDateTime;
    dInfo: BLUETOOTH_DEVICE_INFO;
  end;

  TBluetoothDevice = class(TTgObject)
  protected
    BTDeviceList_: TList<PBtDevEnt>;
    procedure OnBTDeviceNotify(Sender: TObject; const Item: PBtDevEnt;
                              Action: TCollectionNotification);
    function GetCount: Integer;
    function GetBTDeviceByIndex(nIndex: Integer): PBtDevEnt;
  public
    Constructor Create;
    Destructor Destroy; override;

    function RefreshBTDevice(pbWorkStop: PBoolean = nil): Boolean;

    property Count: Integer read GetCount;
    property Items[nIndex: Integer]: PBtDevEnt read GetBTDeviceByIndex; default;
  end;

  PBtRdiEnt = ^TBtRdiEnt;
  TBtRdiEnt = record
    sAddress: String;
    dInfo: BLUETOOTH_RADIO_INFO;
  end;

  TBluetoothRadio = class(TTgObject)
  protected
    BTRadioList_: TList<PBtRdiEnt>;
    procedure OnBTRadioNotify(Sender: TObject; const Item: PBtRdiEnt;
                              Action: TCollectionNotification);
    function GetCount: Integer;
    function GetBTRadioByIndex(nIndex: Integer): PBtRdiEnt;
  public
    Constructor Create;
    Destructor Destroy; override;

    function RefreshBTRadio: Boolean;

    property Count: Integer read GetCount;
    property Items[nIndex: Integer]: PBtRdiEnt read GetBTRadioByIndex; default;
  end;

  TBTChangeState = (csDetection, csConnected, csRemembered, csAuthenticated, csLastSeen, csLastUsed);
  TBTChangeStates = set of TBTChangeState;

  TBtDevChangeNotify = procedure(pEnt: PBtDevEnt; csBT: TBTChangeStates; var bPrevent: Boolean) of object;

  TThdBtDevNotify = class(TTgThread)
  private
    bSync_: Boolean;
    BTDevice_: TBluetoothDevice;
    DcBTDevice_: TDictionary<String,PBtDevEnt>;

    procedure OnBTDeviceNotify(Sender: TObject; const Item: PBtDevEnt;
                              Action: TCollectionNotification);
  protected
    evChangeBTDevice_: TBtDevChangeNotify;

    pBTEntry_: PBtDevEnt;
    csBT_: TBTChangeStates;
    bPreventBtDevs_: Boolean;

    function GetBTDeviceState(aEnt: PBtDevEnt): TBTChangeStates;
    procedure Execute; override;

    procedure ProcessBTDeviceNotify;
  public
    Constructor Create(bSync: Boolean = false);
    Destructor Destroy; override;

    procedure ResetBTDevice;

    property OnChangeBTDevice: TBtDevChangeNotify write evChangeBTDevice_;
    property PreventBtDevs: Boolean write bPreventBtDevs_;
  end;

  procedure BtDevTypeToStr(dwClassOfDevice: DWORD; var sMajor, sMinor: String);

function SetBtDevsEnable(bVal: Boolean): Integer;

implementation

uses
  System.DateUtils, Tocsg.DateTime, Tocsg.Strings, Tocsg.Driver, Tocsg.Convert,
  Tocsg.Exception;

function SetBtDevsEnable(bVal: Boolean): Integer;
var
  hDev: HDEVINFO;
  sdd: TSPDevInfoData;
  i: Integer;
  dwBufSize,
  dwStatus, dwProblem,
  dwPropertyRegDataType: DWORD;
  pBuf: Pointer;
begin
  Result := 0;

  try
    hDev := SetupDiGetClassDevs(@GUID_DEVCLASS_BLUETOOTH, nil, 0, DIGCF_PRESENT);
    if hDev = INVALID_HANDLE_VALUE then
      exit;

    pBuf := nil;
    try
      ZeroMemory(@sdd, SizeOf(sdd));
      sdd.cbSize := SizeOf(sdd);

      i := 0;
      while SetupDiEnumDeviceInfo(hDev, i, sdd) do
      begin
        dwBufSize := 0;
        if pBuf <> nil then
        begin
          FreeMem(pBuf);
          pBuf := nil;
        end;

        while not SetupDiGetDeviceRegistryProperty(hDev, sdd,
                 SPDRP_HARDWAREID, dwPropertyRegDataType, pBuf, dwBufSize, dwBufSize) do
        begin
          if GetLastError = ERROR_INSUFFICIENT_BUFFER then
          begin
            if pBuf <> nil then
              FreeMem(pBuf);
            pBuf := AllocMem(dwBufSize);
          end else break;
        end;

        if pBuf <> nil then
        begin
          if (CompareText('BTH\MS_BTHLE', String(PChar(pBuf))) <> 0) and
             (CompareText('BTH\MS_BTHBRB', String(PChar(pBuf))) <> 0) then
          begin
            dwStatus := 0;
            dwProblem := 0;

            if CM_Get_DevNode_Status(dwStatus, dwProblem, sdd.DevInst, 0) = CR_SUCCESS then
            begin
//              var bDisabled: Boolean := (((dwStatus and DN_HAS_PROBLEM) = 0) and (dwProblem = CM_PROB_DISABLED));
//              if bVal = bDisabled then
              begin
                var PropChangeParams: TSPPropChangeParams;
                ZeroMemory(@PropChangeParams, SizeOf(PropChangeParams));
                PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
                PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
                PropChangeParams.Scope := DICS_FLAG_GLOBAL;
                PropChangeParams.StateChange := BooleanToInt(bVal, DICS_ENABLE, DICS_DISABLE);

                if SetupDiSetClassInstallParams(hDev, @sdd, PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams)) then
                begin
                // 64bit OS 에서는 64bit 프로그램 에서만 실행 가능하다 22_0621 13:59:21 kku
                  if SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDev, @sdd) then
                    Inc(Result);
                end;
              end;
            end;
          end;
        end;

        Inc(i);
      end;

    finally
      SetupDiDestroyDeviceInfoList(hDev);
      if pBuf <> nil then
        FreeMem(pBuf);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. SetBtDevsEnable()');
  end;
end;

{ TBluetoothDevice }

Constructor TBluetoothDevice.Create;
begin
  Inherited Create;
  BTDeviceList_ := TList<PBtDevEnt>.Create;
  BTDeviceList_.OnNotify := OnBTDeviceNotify;
end;

Destructor TBluetoothDevice.Destroy;
begin
  FreeAndNil(BTDeviceList_);
  Inherited;
end;

procedure TBluetoothDevice.OnBTDeviceNotify(Sender: TObject; const Item: PBtDevEnt;
                                              Action: TCollectionNotification);
begin
  case Action of
    cnAdded: ;
    cnRemoved: Dispose(Item);
    cnExtracted: ;
  end;
end;

function TBluetoothDevice.GetCount: Integer;
begin
  Result := BTDeviceList_.Count;
end;

function TBluetoothDevice.GetBTDeviceByIndex(nIndex: Integer): PBtDevEnt;
begin
  Result := nil;
  if (nIndex >= 0) and (nIndex < BTDeviceList_.Count) then
    Result := BTDeviceList_[nIndex];
end;

function TBluetoothDevice.RefreshBTDevice(pbWorkStop: PBoolean = nil): Boolean;
var
  hFind: HBLUETOOTH_DEVICE_FIND;
  BtDevSchParam: BLUETOOTH_DEVICE_SEARCH_PARAMS;
  BtDevInfo: BLUETOOTH_DEVICE_INFO;
  pInfo: PBtDevEnt;
begin
  Result := false;

  BTDeviceList_.Clear;

  ZeroMemory(@BtDevSchParam, SizeOf(BtDevSchParam));
  BtDevSchParam.dwSize := SizeOf(BtDevSchParam);
  BtDevSchParam.fReturnAuthenticated := true;
  BtDevSchParam.fReturnRemembered := true;
  BtDevSchParam.fReturnUnknown := true;
  BtDevSchParam.fReturnConnected := true;
//  BtDevSchParam.fIssueInquiry := true;
//  BtDevSchParam.cTimeoutMultiplier := 10;

  ZeroMemory(@BtDevInfo, SizeOf(BtDevInfo));
  BtDevInfo.dwSize := SizeOf(BtDevInfo);
  hFind := BluetoothFindFirstDevice(BtDevSchParam, BtDevInfo);

  try
    if hFind <> 0 then
    begin
      repeat
        New(pInfo);
        ZeroMemory(pInfo, SizeOf(TBtDevEnt));

        BluetoothUpdateDeviceRecord(BtDevInfo);
        pInfo.dInfo := BtDevInfo;
        pInfo.sAddress := Format('%.2x:%.2x:%.2x:%.2x:%.2x:%.2x',
              [BtDevInfo.Address.rgBytes[5], BtDevInfo.Address.rgBytes[4],
               BtDevInfo.Address.rgBytes[3], BtDevInfo.Address.rgBytes[2],
               BtDevInfo.Address.rgBytes[1], BtDevInfo.Address.rgBytes[0]]);

        pInfo.dtLastSeen := ConvSystemTimeToDateTime_Local(BtDevInfo.stLastSeen);
        try
          if BtDevInfo.stLastUsed.wYear <> 0 then
            pInfo.dtLastUsed := ConvSystemTimeToDateTime_Local(BtDevInfo.stLastUsed)
          else
            pInfo.dtLastUsed := 0;
        except
          pInfo.dtLastUsed := 0;
        end;
        BTDeviceList_.Add(pInfo);

        if (pbWorkStop <> nil) and (pbWorkStop^ = true) then
          exit;
      until (hFind <> 0) and not BluetoothFindNextDevice(hFind, BtDevInfo);
      Result := true;
    end;
  finally
    if hFind <> 0 then
    begin
      BluetoothFindDeviceClose(hFind);
    end;
  end;
end;

{ TBluetoothRadio }

Constructor TBluetoothRadio.Create;
begin
  BTRadioList_ := TList<PBtRdiEnt>.Create;
  BTRadioList_.OnNotify := OnBTRadioNotify;
end;

Destructor TBluetoothRadio.Destroy;
begin
  FreeAndNil(BTRadioList_);
  Inherited;
end;

procedure TBluetoothRadio.OnBTRadioNotify(Sender: TObject; const Item: PBtRdiEnt;
                        Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Dispose(Item);
end;

function TBluetoothRadio.GetCount: Integer;
begin
  Result := BTRadioList_.Count;
end;

function TBluetoothRadio.GetBTRadioByIndex(nIndex: Integer): PBtRdiEnt;
begin
  Result := nil;
  if (nIndex >= 0) and (nIndex < BTRadioList_.Count) then
    Result := BTRadioList_[nIndex];
end;

function TBluetoothRadio.RefreshBTRadio: Boolean;
var
  hFind: HBLUETOOTH_RADIO_FIND;
  hRadio: THandle;
  BtRadiFindParam: BLUETOOTH_FIND_RADIO_PARAMS;
  BtRadiInfo: BLUETOOTH_RADIO_INFO;
  pInfo: PBtRdiEnt;
begin
  Result := false;

  BTRadioList_.Clear;

  ZeroMemory(@BtRadiFindParam, SizeOf(BtRadiFindParam));
  BtRadiFindParam.dwSize := SizeOf(BtRadiFindParam);
  ZeroMemory(@BtRadiInfo, SizeOf(BtRadiInfo));
  BtRadiInfo.dwSize := SizeOf(BtRadiInfo);
  hRadio := 0;

  hFind := BluetoothFindFirstRadio(@BtRadiFindParam, hRadio);

  try
    if hFind <> 0 then
    begin
      repeat
        if BluetoothGetRadioInfo(hRadio, BtRadiInfo) = 0 then
        begin
          New(pInfo);
          ZeroMemory(pInfo, SizeOf(TBtDevEnt));

          pInfo.dInfo := BtRadiInfo;
          pInfo.sAddress := Format('%.2x:%.2x:%.2x:%.2x:%.2x:%.2x',
                [BtRadiInfo.Address.rgBytes[5], BtRadiInfo.Address.rgBytes[4],
                 BtRadiInfo.Address.rgBytes[3], BtRadiInfo.Address.rgBytes[2],
                 BtRadiInfo.Address.rgBytes[1], BtRadiInfo.Address.rgBytes[0]]);

          BTRadioList_.Add(pInfo);
        end;
      until (hFind <> 0) and not BluetoothFindNextRadio(hFind, hRadio);
      Result := true;
    end;
  finally
    if hFind <> 0 then
    begin
      BluetoothFindRadioClose(hFind);
    end;
  end;
end;

{ TThdBtDevNotify }

Constructor TThdBtDevNotify.Create(bSync: Boolean = false);
begin
  Inherited Create;
  bSync_ := bSync;
  DcBTDevice_ := TDictionary<String,PBtDevEnt>.Create;
  DcBTDevice_.OnValueNotify := OnBTDeviceNotify;
  BTDevice_ := TBluetoothDevice.Create;
  bPreventBtDevs_ := false;
end;

Destructor TThdBtDevNotify.Destroy;
begin
  Inherited;
  FreeAndNil(BTDevice_);
  FreeAndNil(DcBTDevice_);
end;

procedure TThdBtDevNotify.OnBTDeviceNotify(Sender: TObject; const Item: PBtDevEnt;
                                          Action: TCollectionNotification);
begin
  case Action of
    cnAdded: ;
    cnRemoved: Dispose(Item);
    cnExtracted: ;
  end;
end;

procedure TThdBtDevNotify.ResetBTDevice;
begin
  Lock;
  try
    DcBTDevice_.Clear;
  finally
    Unlock;
  end;
end;

procedure TThdBtDevNotify.ProcessBTDeviceNotify;
var
  bPrevent: Boolean;
begin
  if Assigned(evChangeBTDevice_) then
  begin
    evChangeBTDevice_(pBTEntry_, csBT_, bPrevent);
    if bPrevent then
      bPreventBtDevs_ := true;
  end;
end;

function TThdBtDevNotify.GetBTDeviceState(aEnt: PBtDevEnt): TBTChangeStates;
var
  pEntry: PBtDevEnt;
begin
  Result := [];

  Lock;
  try
    if DcBTDevice_.ContainsKey(aEnt.sAddress) then
      pEntry := DcBTDevice_[aEnt.sAddress]
    else
      pEntry := nil;
  finally
    Unlock;
  end;

  if pEntry <> nil then
  begin
    if pEntry.dInfo.fConnected <> aEnt.dInfo.fConnected then
      Include(Result, csConnected);
    if pEntry.dInfo.fRemembered <> aEnt.dInfo.fRemembered then
      Include(Result, csRemembered);
    if pEntry.dInfo.fAuthenticated <> aEnt.dInfo.fAuthenticated then
      Include(Result, csAuthenticated);
  // LastSeen은 BluetoothFindFirstDevice 이거 돌릴때마다 변경 12_1102 17:37 kku 
//    if not SameDateTime(pEntry.dtLastSeen, aEnt.dtLastSeen)  then
//      Include(Result, csLastSeen);
    if not SameDateTime(pEntry.dtLastUsed, aEnt.dtLastUsed) then
      Include(Result, csLastUsed);
    pEntry^ := aEnt^;
  end else begin
    New(pEntry);
    pEntry^ := aEnt^;
    Lock;
    try
      DcBTDevice_.Add(pEntry.sAddress, pEntry);
    finally
      Unlock;
    end;
    Include(Result, csDetection);
//    if pEntry.dInfo.fConnected then
//      Include(Result, csConnected);
//    if pEntry.dInfo.fRemembered then
//      Include(Result, csRemembered);
//    if pEntry.dInfo.fAuthenticated then
//      Include(Result, csAuthenticated);
  end;
end;

procedure TThdBtDevNotify.Execute;
var
  i: Integer;
  dwPvTick: DWORD;
begin
  dwPvTick := 0;
  while not Terminated and not GetWorkStop do
  begin
    if BTDevice_.RefreshBTDevice(@bWorkStop_) then
      for i := 0 to BTDevice_.Count - 1 do
      begin
        if bWorkStop_ then
          break;

        pBTEntry_ := BTDevice_[i];

        csBT_ := GetBTDeviceState(pBTEntry_);
        if csBT_ <> [] then
        begin
          if bSync_ then
            Synchronize(ProcessBTDeviceNotify)
          else
            ProcessBTDeviceNotify;
        end;
      end
    else Sleep(1000);

    if bPreventBtDevs_ then
    begin
      bPreventBtDevs_ := false;
      SetBtDevsEnable(false);
      dwPvTick := GetTickCount;
    end;

    if (dwPvTick <> 0) and ((GetTickCount - dwPvTick) >= 4000) then
    begin
      dwPvTick := 0;
      SetBtDevsEnable(true);
    end;

    Sleep(1000);
  end;
end;

// 디바이스 타입 구하기 = 개노가닥 2010-12-16 kku 
// 참고 : http://slexy.org/view/s2vpOPLzA7
procedure BtDevTypeToStr(dwClassOfDevice: DWORD; var sMajor, sMinor: String);
var
  ucMajor,
  ucMinor: BYTE;
begin
  ucMajor := BYTE((dwClassOfDevice and $0000FF00) shr 8);
  ucMinor := BYTE(dwClassOfDevice and $000000FF);

  case ucMajor of
    BT_DEVICE_CLASS_MISC           : sMajor := 'Misc';
    BT_DEVICE_CLASS_COMPUTER       : sMajor := 'Computer';
    BT_DEVICE_CLASS_PHONE          : sMajor := 'Phone';
    BT_DEVICE_CLASS_LANACCESSPOINT : sMajor := 'LanAccessPoint';
    BT_DEVICE_CLASS_AV             : sMajor := 'Audio/Video';
    BT_DEVICE_CLASS_PERIPHERAL     : sMajor := 'Peripheral';
    BT_DEVICE_CLASS_IMAGING        : sMajor := 'Imaging';
    BT_DEVICE_CLASS_UNCLASSIFIED   : sMajor := 'Unclassified';
  end;

  case (ucMajor and $0F) of
    0 : sMinor := 'None';
    1 :
      case ((ucMinor and $0F) shr 2) of
        0 : sMinor := 'Uncategorised';
        1 : sMinor := 'Desktop';
        2 : sMinor := 'Server';
        3 : sMinor := 'Laptop';
        4 : sMinor := 'Handheld';
        5 : sMinor := 'Palm';
        6 : sMinor := 'Wearable';
      end;
    2 :
      case ((ucMinor and $0F) shr 2) of
        0 : sMinor := 'Uncategorised';
        1 : sMinor := 'Mobile';
        2 : sMinor := 'Cordless';
        3 : sMinor := 'Smart phone';
        4 : sMinor := 'Wired modem or voice gateway';
        5 : sMinor := 'Common ISDN access';
        6 : sMinor := 'Sim card reader';
      end;
    3 :
      begin
        if ((ucMinor and $0F) shr 2) = 0 then
          sMinor := 'Uncategorised'
        else
          case (((ucMinor and $0F) shr 2) div 8) of
            0 : sMinor := 'Fully available';
            1 : sMinor := '1-17%% available';
            2 : sMinor := '17-33%% utilised';
            3 : sMinor := '33-50%% utilised';
            4 : sMinor := '50-67%% utilised';
            5 : sMinor := '67-83%% utilised';
            6 : sMinor := '83-99%% utilised';
            7 : sMinor := 'No service available';
          end;
      end;
    4 :
      case ((ucMinor and $0F) shr 2) of
        0 : sMinor := 'Uncategorised';
        1 : sMinor := 'Device conforms to the Headset profile';
        2 : sMinor := 'Hands-free';
        3 : sMinor := 'Reserved';
        4 : sMinor := 'Microphone';
        5 : sMinor := 'Loudspeaker';
        6 : sMinor := 'Headphones';
        7 : sMinor := 'Portable audio';
        8 : sMinor := 'Car audio';
        9 : sMinor := 'Set-top box';
       10 : sMinor := 'HiFi audio device';
       11 : sMinor := 'VCR';
       12 : sMinor := 'Video camera';
       13 : sMinor := 'Camcorder';
       14 : sMinor := 'Video monitor';
       15 : sMinor := 'Video display and loudspeaker';
       16 : sMinor := 'Video conferencing';
       17 : sMinor := 'Reserved';
       18 : sMinor := 'Gaming/toy';
      end;
    5 :
      begin
        case (((ucMinor and $0F) shr 2) and 48) of
          16 : sMinor := 'Keyboard';
          32 : sMinor := 'Pointing device';
          48 :
            begin
              sMinor := 'Combo keyboard/pointing device';
              sMinor := sMinor + ' - ';

              case (((ucMinor and $0F) shr 2) and 15) of
                1 : sMinor := sMinor + 'Joystick';
                2 : sMinor := sMinor + 'Gamepad';
                3 : sMinor := sMinor + 'Remote control';
                4 : sMinor := sMinor + 'Sensing device';
                5 : sMinor := sMinor + 'Digitiser tablet';
                6 : sMinor := sMinor + 'Card reader';
                else
                  sMinor := sMinor + 'Reserved';
              end;
            end;
        end;
      end;
    6 :
      if (((ucMinor and $0F) shr 2) and 4) <> 0 then
        sMinor := 'Display'
      else if (((ucMinor and $0F) shr 2) and 8) <> 0 then
        sMinor := 'Camera'
      else if (((ucMinor and $0F) shr 2) and 16) <> 0 then
        sMinor := 'Scanner'
      else if (((ucMinor and $0F) shr 2) and 32) <> 0 then
        sMinor := 'Printer';
    7 :
      case ((ucMinor and $0F) shr 2) of
        1 : sMinor := 'Wrist watch';
        2 : sMinor := 'Pager';
        3 : sMinor := 'Jacket';
        4 : sMinor := 'Helmet';
        5 : sMinor := 'Glasses';
      end;
    8 :
      case ((ucMinor and $0F) shr 2) of
        1 : sMinor := 'Robot';
        2 : sMinor := 'Vehicle';
        3 : sMinor := 'Doll/action figure';
        4 : sMinor := 'Controller';
        5 : sMinor := 'Game';
      end;
  end;

  if sMinor = '' then
    sMinor := 'None';
end;

end.