{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Bluetooth support (VCL)                         }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 20 Feb 2010                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrbt;
interface
uses  classes, messages, windows,
      {$IFDEF NR_WITH_CONTROLS}
      controls,stdctrls,forms,
      {$ENDIF}
      nrcomm,nrclasses,nrwin32, nrbtw32;

Const

  esBtInit          = 'Bluetooth system API is not found.';
  esBtNoRadios      = 'There are no bluetooth adapters';
  esBtNoDevices     = 'There are no bluetooth devices.';
  esBtNoSelDevices  = 'There are no selected bluetooth devices.';
  esBtNoConnect     = 'Connect to selected bluetooth device failed #';
  esBtWinSock       = 'Socket error  #';

Type

  TnrBTRadio = class(TnrDevice)
  private
    procedure SetIsConnectable(const Value: boolean);
    procedure SetIsDiscoverable(const Value: boolean);
    function GetIsConnectable: boolean;
    function GetIsDiscoverable: boolean;
  public
    Address:BLUETOOTH_ADDRESS;
    constructor Create(aOwner:TnrBaseIO; aIndex:integer);
    property IsConnectable:boolean read GetIsConnectable write SetIsConnectable;
    property IsDiscoverable:boolean read GetIsDiscoverable write SetIsDiscoverable;
  end;

  TnrBTService = class
  private
    fCaption:string;
    fComment:string;
    fGUID:System.TGUID;
    fQuerySet:WSAQUERYSET;
    function GetCaption: string;
    function GetComment: string;
    function GetGUID: System.TGUID;
    function GetQuerySet: WSAQUERYSET;
  public
    procedure SetInfo(aQuerySet:WSAQUERYSET);
    property Caption:string read GetCaption;
    property Comment:string read GetComment;
    property GUID:System.TGUID read GetGUID;
    property QuerySet:WSAQUERYSET read GetQuerySet;
  end;

  TnrBTDevice = class(TnrDevice)
  private
    fServices:TList;
    fServiceIndex: integer;
    fLastError:integer;
    function GetServices(Index: integer): TnrBTService;
    procedure ServicesClear;
    function GetServiceCount: integer;
    function GetAddressAsStr: string;
    procedure SetServiceIndex(const Value: integer);
    function GetServiceIndex: integer;
  public
    Address: BLUETOOTH_ADDRESS;
    btInfo:  BLUETOOTH_DEVICE_INFO;
    LastSeen:TDateTime;
    LastUsed:TDateTime;
    IndexRadio:integer;
    constructor Create;
    destructor Destroy; override;
    procedure Update;
    property ServiceCount:integer read GetServiceCount;
    property Services[Index:integer]:TnrBTService read GetServices;
    property AddressAsStr:string read GetAddressAsStr;
    property ServiceIndex:integer read GetServiceIndex write SetServiceIndex;
  end;

  TnrBtDeviceEnumerate = set of (bteAuthenticated, bteRemembered,
                                 bteUnknown, bteConnected, bteIssueInquiry, bteAllRadios);

  TnrBT=class(TnrBaseIO)
  private
    fRadioIndex:integer;
    fDeviceIndex:integer;
    lRadios:TList;
    fDeviceEnum:TnrBtDeviceEnumerate;
    fDeviceEnumTimeout:integer;
    fOnConnect: TNotifyEvent;
    fOnDisconnect: TNotifyEvent;
    fOnAfterReceive:TOnReceived;
    fOnAfterSend:TOnSent;
    fBuffer:PAnsiChar;
    flDontRead : boolean;
    fBufferInSize:integer;
    fBufferOutSize:integer;
    edx: cardinal;
    procedure RadioReload;
    procedure RadioClear;
    function GetRadio(Index: integer): TnrBTRadio;
    function GetRadioCount: integer;
    function GetRadioIndex: integer;
    procedure SetRadioIndex(const Value: integer);
    function GetBTDevice(Index: integer): TnrBTDevice;
    function GetDeviceEnum: TnrBtDeviceEnumerate;
    procedure SetDeviceEnum(const Value: TnrBtDeviceEnumerate);
    function GetDeviceEnumTimeout: integer;
    procedure SetDeviceEnumTimeout(const Value: integer);
    function GetReadyForRead: cardinal;
    function GetOnReceived: TOnReceived;
    function GetOnSent: TOnSent;
    procedure SetOnReceived(const Value: TOnReceived);
    procedure SetOnSent(const Value: TOnSent);
    function GetBufferInSize: integer;
    function GetBufferOutSize: integer;
    procedure SetBufferInSize(const Value: integer);
    procedure SetBufferOutSize(const Value: integer);
    procedure BufferSizeUpdate;
    procedure UpdateInternalBuffer;
  protected

    function RequestDeviceHandle:THandle; override;
    procedure RequestDeviceHandleClose(aHandle:THandle);  override;
    procedure Open; override;
    procedure DeviceListLoad; override;
    procedure Loaded; override;
    procedure SetDeviceIndex(const Value: integer); override;
    function GetDeviceIndex: integer; override;
    function GetDeviceIndexByAddress(aAddress:BLUETOOTH_ADDRESS):integer;
    procedure SetBlockMode(flBlock:boolean);
    procedure OnReceiveData(aSender:TObject);
    procedure OnSentData(aSender:TObject);
    procedure ThreadExecute(aThread:TThread); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    procedure Update; override;
    procedure ConfigDialog;
    function SelectDeviceDialog(sInfo:WideString; flForceAuth, flAddWiz, flSkipServices:boolean):boolean;

    procedure SendChar(const Ch:Char);    override;
    procedure SendString(const S:AnsiString); override;
    procedure SendData(const Buff:PAnsiChar;const N:cardinal);override;
    procedure Read(Buffer:PChar;Len:cardinal);
    procedure ReadAll(Buffer:PChar);
    function ReadString:string;
    function WaitForBytes(Count:cardinal;Ms:cardinal):boolean;
    function AuthenticateDevice(const passKey: WideString): boolean; // thanks to Andrei Skatchkov <AS@somnomedics.de>
    property RadioCount:integer read GetRadioCount;
    property Radio[Index:integer]:TnrBTRadio read GetRadio;
    property Device[Index:integer]:TnrBTDevice read GetBTDevice;
    property ReadyForRead:cardinal read GetReadyForRead;
    property BufferInSize:integer read GetBufferInSize write SetBufferInSize;
    property BufferOutSize:integer read GetBufferOutSize write SetBufferOutSize;
    property TotalReceived:cardinal read edx;

  published
    property RadioIndex:integer read GetRadioIndex write SetRadioIndex;
    property DeviceEnum:TnrBtDeviceEnumerate read GetDeviceEnum write SetDeviceEnum;
    property DeviceEnumTimeout:integer read GetDeviceEnumTimeout write SetDeviceEnumTimeout;

    {$IFDEF NR_WITH_CONTROLS}
    property Terminal;
    property TerminalUsage;
    property TerminalEcho;
    {$ENDIF}
    property Priority;
    property UseMainThread;
    property OnConnect:TNotifyEvent read fOnConnect write fOnConnect;
    property OnDisconnect:TNotifyEvent read fOnDisconnect write fOnDisconnect;
    property DeviceIndex;
    property Log;
    property OnFatalError;
    property Active;
    property OnAfterReceive:TOnReceived read GetOnReceived write SetOnReceived;
    property OnAfterSend:TOnSent read GetOnSent write SetOnSent;
    property DataProcessor;
  end;

implementation
uses sysutils, winsock, nrsysutils;

const

  gci_BTServices  = 18;
  // don't change first two items ... order is important !!!
  gca_BTServices : array [0 ..gci_BTServices-1]  of pointer=(
                        @DialupNetworkingServiceClass_UUID,
                        @SerialPortServiceClass_UUID,
                        @OBEXObjectPushServiceClass_UUID,
                        @OBEXFileTransferServiceClass_UUID,
                        @HeadsetServiceClass_UUID,
                        @CordlessTelephonyServiceClass_UUID,
                        @AudioSourceServiceClass_UUID,
                        @AudioSinkServiceClass_UUID,
                        @FaxServiceClass_UUID,
                        @WAPServiceClass_UUID,
                        @WAPClientServiceClass_UUID,
                        @HandsfreeServiceClass_UUID,
                        @HandsfreeAudioGatewayServiceClass_UUID,
                        @HumanInterfaceDeviceServiceClass_UUID,
                        @GenericNetworkingServiceClass_UUID,
                        @GenericFileTransferServiceClass_UUID,
                        @GenericAudioServiceClass_UUID,
                        @GenericTelephonyServiceClass_UUID
                   );

function IsBtAddressEqual(Addr1,Addr2:BLUETOOTH_ADDRESS):boolean;
begin
  {$IFDEF GEN3}
  Result := ((Addr1.ullLong[0] = Addr2.ullLong[0]) and
             (Addr1.ullLong[1] = Addr2.ullLong[1]) );
  {$ELSE}
  Result := ( Addr1.ullLong = Addr2.ullLong );
  {$ENDIF}
end;

{ TnrBTRadio }

constructor TnrBTRadio.Create(aOwner: TnrBaseIO; aIndex: integer);
begin
  inherited Create;
  fParent := aOwner;
  fIndex := aIndex;
end;

function TnrBTRadio.GetIsConnectable: boolean;
begin
  Result := BluetoothIsConnectable(Handle);
end;

function TnrBTRadio.GetIsDiscoverable: boolean;
begin
  Result := BluetoothIsDiscoverable(Handle);
end;

procedure TnrBTRadio.SetIsConnectable(const Value: boolean);
begin
  BluetoothEnableIncomingConnections(Handle,Value);
end;

procedure TnrBTRadio.SetIsDiscoverable(const Value: boolean);
begin
  BluetoothEnableDiscovery(Handle,Value);
end;


{ TnrBTService }

function TnrBTService.GetCaption: string;
begin
  Result := fCaption;
end;

function TnrBTService.GetComment: string;
begin
  Result := fComment;
end;

function TnrBTService.GetGUID: System.TGUID;
begin
  Result := fGUID;
end;

function TnrBTService.GetQuerySet: WSAQUERYSET;
begin
  Result := fQuerySet;
end;

procedure TnrBTService.SetInfo(aQuerySet: WSAQUERYSET);
begin
  fCaption := String(aQuerySet.lpszServiceInstanceName);
  fComment := String(aQuerySet.lpszComment);
  CopyMemory(@fQuerySet,@aQuerySet,SizeOf(WSAQUERYSET));
  fQuerySet.lpszServiceInstanceName := PAnsiChar(AnsiString(fCaption));
  fQuerySet.lpszComment := PAnsiChar(AnsiString(fComment));
end;

{ TnrBTDevice }

constructor TnrBTDevice.Create;
begin
  inherited;
  fServices := TList.Create;
  fServiceIndex := -1;
end;

destructor TnrBTDevice.Destroy;
begin
  ServicesClear;
  fServices.Free;
  inherited;
end;

function TnrBTDevice.GetAddressAsStr: string;
var i:integer;
begin
  Result := '(';
  for i:= 5 downto 0 do Result := Result + Format('%.2x',[Address.rgBytes[i]])+':';
  Result[Length(Result)] := ')';
end;

function TnrBTDevice.GetServiceCount: integer;
begin
  Result := fServices.Count;
end;

function TnrBTDevice.GetServiceIndex: integer;
begin
  Result := fServiceIndex;
end;

function TnrBTDevice.GetServices(Index: integer):  TnrBTService;
begin
  Result :=  TnrBTService(fServices[Index]);
end;

procedure TnrBTDevice.ServicesClear;
var i:integer;
begin
  for i := 0 to fServices.Count - 1 do Services[i].Free;
  fServices.Clear;
end;

procedure TnrBTDevice.SetServiceIndex(const Value: integer);
begin
  fServiceIndex := Value;
end;

{$IFDEF TRIAL}
{$I nr_trial.inc}
{$ENDIF}

procedure TnrBTDevice.Update;
var qs:WSAQUERYSET;
    qsResult:PWSAQUERYSET;
    hFind:THandle;
    fl,sz:dword;
    i,j:integer;
    pBuffer:PAnsiCHar;
    srv : TnrBTService;
    sDevAddr:AnsiString;
begin
  ServicesClear;
  sDevAddr := AnsiString(AddressAsStr);
  fLastError := 0;

{  hRadio := TnrBT(Parent).Radio[IndexRadio].Handle;
  BluetoothEnumerateInstalledServices(hRadio, btInfo,
                                       fServiceCount, nil);
  SetLength(fServices, fServiceCount);
  BluetoothEnumerateInstalledServices(hRadio, btInfo, fServiceCount,
                                              Pointer(fServices));
 }

  for i := 0 to gci_BTServices-1 do begin
    sz := 1000;
    FillChar(qs, SizeOf(WSAQUERYSET), 0);
    qs.dwSize := sizeof(WSAQUERYSET);
    qs.dwNameSpace      := NS_BTH;
    qs.lpServiceClassId := gca_BTServices[i];
    qs.lpszContext      := PAnsiChar(sDevAddr);

    fl := LUP_FLUSHCACHE or LUP_RETURN_NAME or LUP_RETURN_TYPE or
             LUP_RETURN_ADDR or LUP_RETURN_BLOB or LUP_RETURN_COMMENT;

    hFind := 0;
    if WSALookupServiceBegin(@qs, fl, hFind) = 0 then begin
      sz := 2000;
      pBuffer := PAnsiChar(StrAlloc(sz));
      qsResult := Pointer(pBuffer);
      while WSALookupServiceNext(hFind,fl,sz, qsResult) = 0 do begin
        srv := TnrBTService.Create;
        srv.SetInfo(qsResult^);
        srv.fGUID := qs.lpServiceClassId^;
        j := fServices.Add(srv);
        if fServiceIndex < 0 then fServiceIndex := j;
      end;
      WSALookupServiceEnd(hFind);
      StrDispose(pBuffer);
    end else begin
      fLastError := WSAGetLastError;
      break;
    end;

  end;

  if fServiceIndex >= fServices.Count
    then fServiceIndex := fServices.Count - 1;

end;

{ TnrBlueTooth }

constructor TnrBT.Create(AOwner: TComponent);
var WinSockInitData: TWSADATA;
begin
  FillChar(WinSockInitData,0,SizeOf(WinSockInitData));
  WSAStartup($0202,WinSockInitData);
  inherited;
  sLogPrefix:='nrBT: ';
  lRadios := TList.Create;
  fDeviceEnum := [bteRemembered,bteConnected,bteAllRadios];
  fDeviceEnumTimeout := 5;

  {$IFDEF TRIAL}
  ng_alrt;
  {$ENDIF}

  fDeviceIndex := -1;
  fBufferInSize := 1024*8;
  fBufferOutSize := fBufferInSize;
  UpdateInternalBuffer;
end;

destructor TnrBT.Destroy;
begin
  if Active then Close;
  RadioClear;
  lRadios.Free;
  LocalFree(Cardinal(fBuffer));
  fBuffer := nil;
  inherited Destroy;
  WSACleanup;
end;

procedure TnrBT.Open;
begin
  isThreaded := true;
  inherited Open;
  if IsHandleValid then begin
    Logging(dlDetail,'Opened: ' + Device[DeviceIndex].NameFriendly + ' ' +
                              Device[DeviceIndex].AddressAsStr+' '+
                              nrSysUtils.GUIDToString(
                              Device[DeviceIndex].Services[Device[DeviceIndex].ServiceIndex].GUID
                              )
                              );

    BufferSizeUpdate;
    //TnrBTThread.Create(Self, False, OnReceiveData);
    {$IFDEF TRIAL}
    cnt_alrt;
    {$ENDIF}
    if Assigned(fOnConnect) then fOnConnect(Self);
    DoNotify(csOpened);
  end;
end;

function TnrBT.RequestDeviceHandle: THandle;
var sckAddr: SOCKADDR_BTH;
    err:dword;
begin

  Result := INVALID_HANDLE_VALUE;

  if not AllocBTAPI then begin
    DoFatalErrors(ECC_BT,ECCE_GENERAL_INIT,esBtInit,False);
    exit;
  end;

  if RadioCount = 0 then begin
    DoFatalErrors(ECC_BT,ECCE_NO_DEVICES,esBtNoRadios,False);
    exit;
  end;

  if DeviceCount = 0 then begin
    DoFatalErrors(ECC_BT,ECCE_NO_DEVICES,esBtNoDevices,False);
    exit;
  end;

  if DeviceIndex < 0 then begin
    DoFatalErrors(ECC_BT,ECCE_NOT_SELECTED_DEVICE,esBtNoSelDevices,False);
    exit;
  end;

  FillChar(sckAddr, SizeOf(SOCKADDR_BTH), 0);
  sckAddr.addressFamily := AF_BTH;
  sckAddr.btAddr :=  Device[DeviceIndex].Address.ullLong;

  // if services are not detected - try it ...
  if Device[DeviceIndex].ServiceCount <=0 then begin
    Device[DeviceIndex].Update;
    err := Device[DeviceIndex].fLastError;
    if err <> 0 then begin
      DoFatalErrors(ECC_BT,err, esBtWinSock +  ' =0= ' + IntToStr(err),False);
      exit;
    end;
  end;

  // if active service is not detected - try it ...
  if Device[DeviceIndex].ServiceIndex < 0
    then sckAddr.serviceClassId := TGUID(gca_BTServices[0]^)// DialupNetworkingServiceClass_UUID
    else sckAddr.serviceClassId := Device[DeviceIndex].Services[Device[DeviceIndex].ServiceIndex].GUID;
//  sckAddr.serviceClassId := DialupNetworkingServiceClass_UUID;// SerialPortServiceClass_UUID;

  Result := socket(AF_BTH, SOCK_STREAM, BTHPROTO_RFCOMM);

  if Integer(Result) <> INVALID_SOCKET then begin
    if nrBtw32.connect(Result, @sckAddr, SizeOf(SOCKADDR_BTH)) <> 0  then begin
      err := WSAGetLastError;
      closesocket(Result);
      Result := INVALID_HANDLE_VALUE;
      DoFatalErrors(ECC_BT,err, esBtNoConnect +  ' =1='  + IntToStr(err),False);
    end;

  end else begin
    err := WSAGetLastError;
    DoFatalErrors(ECC_BT,err, esBtWinSock +  ' =2=' + IntToStr(err),False);
  end;

end;

procedure TnrBT.RequestDeviceHandleClose(aHandle: THandle);
begin
  isThreaded := false;
  closesocket(aHandle);
end;

procedure TnrBT.ThreadExecute(aThread: TThread);
var sockSet:TFDSet;
    sz:cardinal;
    flReadNeeded:boolean;
begin

  inherited;

  sockSet.fd_count := 1;
  sockSet.fd_array[0] := Handle;

  Try

  while not IsThreadIOTerminated do begin

    if select(0, @sockSet, nil, @sockSet, nil) = SOCKET_ERROR then begin
      //Terminate;
      //TnrBT(fOwner).Close;
      break;
    end else begin
      sz := ReadyForRead;
      Inc(edx, sz);
      flReadNeeded := IsReadNeeded;
      if flReadNeeded and (not flDontRead) then begin
        SetBlockMode(True);
        recv(Handle,fBuffer^,sz,0);
        DoInputData(fBuffer, sz);
      end;

    end;
  end;

  except
    OutputDebugString('Thread except 0 ...');
  end;

  IsThreadIOTerminated := True;

end;

procedure TnrBT.Loaded;
begin
  inherited Loaded;
  Update;
  SetActive(fActive);
end;

function TnrBT.GetDeviceIndex: integer;
begin
  Result := fDeviceIndex;
end;

procedure TnrBT.SetDeviceIndex(const Value: integer);
begin
  fDeviceIndex := Value;
  inherited;
end;

function TnrBT.GetBTDevice(Index: integer): TnrBTDevice;
begin
  Result := TnrBTDevice(inherited Device[Index]);
end;

function TnrBT.GetRadio(Index: integer): TnrBTRadio;
begin
  Result := TnrBTRadio(lRadios[Index]);
end;

function TnrBT.GetRadioCount: integer;
begin
  Result := lRadios.Count;
end;

function TnrBT.GetRadioIndex: integer;
begin
  Result :=  fRadioIndex;
end;

procedure TnrBT.SetRadioIndex(const Value: integer);
begin
  if fRadioIndex <> Value then begin
    fRadioIndex := Value;
    DeviceListLoad;
  end;
end;

procedure TnrBT.RadioClear;
var i:integer;
begin
  DeviceListClear;
  for i := 0 to lRadios.Count - 1 do Radio[i].Free;
  lRadios.Clear;
end;

function TnrBT.GetDeviceIndexByAddress(aAddress: BLUETOOTH_ADDRESS): integer;
var i:integer;
begin
  Result := -1;
  for i := 0 to DeviceCount - 1 do
    if IsBtAddressEqual(Device[i].Address,aAddress) then begin
      Result := i;
      break;
    end;
end;

procedure TnrBT.Update;
begin
  RadioReload;
  DeviceListLoad;
  inherited Update;
end;

procedure TnrBT.DeviceListLoad;
var
  strSrch: BLUETOOTH_DEVICE_SEARCH_PARAMS;
  strDevInf: BLUETOOTH_DEVICE_INFO;
  hDevFind: dword;
  aDev:TnrBTDevice;
  idxRadio:integer;
begin
  DeviceListClear;

  if RadioCount = 0 then exit;

  FillChar(strSrch, SizeOf(BLUETOOTH_DEVICE_SEARCH_PARAMS), 0);
  strSrch.dwSize := SizeOf(BLUETOOTH_DEVICE_SEARCH_PARAMS);

  strSrch.fReturnAuthenticated := bteAuthenticated in fDeviceEnum;
  strSrch.fReturnRemembered := bteRemembered in fDeviceEnum;
  strSrch.fReturnConnected := bteConnected in fDeviceEnum;
  strSrch.fReturnUnknown := bteUnknown in fDeviceEnum;

  if fDeviceEnumTimeout > 0 then begin
    strSrch.fIssueInquiry := bteIssueInquiry in fDeviceEnum;
    strSrch.cTimeoutMultiplier := (fDeviceEnumTimeout * 100) div 128;
  end;


  if bteAllRadios in fDeviceEnum
    then idxRadio := 0
    else idxRadio := RadioIndex;

  repeat
    strSrch.hRadio := Radio[idxRadio].Handle;

    FillChar(strDevInf, SizeOf(BLUETOOTH_DEVICE_INFO), 0);
    strDevInf.dwSize := SizeOf(BLUETOOTH_DEVICE_INFO);

    hDevFind := BluetoothFindFirstDevice(strSrch, strDevInf);
    if (hDevFind <> 0) then begin
      repeat
        aDev := TnrBTDevice.Create;
        aDev.NameFriendly := strDevInf.szName;
        aDev.Address := strDevInf.Address;
        aDev.btInfo := strDevInf;
        aDev.IndexRadio := idxRadio;

        try
          if strDevInf.stLastSeen.wYear > 0
            then aDev.LastSeen := SystemTimeToDateTime(strDevInf.stLastSeen);
        except
        end;

        try
          if strDevInf.stLastUsed.wYear > 0
            then aDev.LastUsed := SystemTimeToDateTime(strDevInf.stLastUsed);
        except
        end;

        AddDevice(aDev);
        FillChar(strDevInf, SizeOf(BLUETOOTH_DEVICE_INFO), 0);
        strDevInf.dwSize := SizeOf(BLUETOOTH_DEVICE_INFO);
      until (not BluetoothFindNextDevice(hDevFind, strDevInf));
      BluetoothFindDeviceClose(hDevFind);
    end;

    if bteAllRadios in fDeviceEnum then Inc(idxRadio);

  until idxRadio >= RadioCount;

end;

procedure TnrBT.RadioReload;
var st0:BLUETOOTH_FIND_RADIO_PARAMS;
    stInf:BLUETOOTH_RADIO_INFO;
    hRadio,hFind : THandle;
    rs:dword;
    s:string;
    aR:TnrBTRadio;
begin
  RadioClear;
  st0.dwSize := SizeOf(BLUETOOTH_FIND_RADIO_PARAMS);
  hFind := BluetoothFindFirstRadio(st0,hRadio);
  if hFind <> 0 then begin
    repeat
      stInf.dwSize := SizeOf(stInf);
      rs := BluetoothGetRadioInfo(hRadio, stInf);
      if  rs = ERROR_SUCCESS then begin
        s := WideString(stInf.szName);
        aR := TnrBTRadio.Create(Self,lRadios.Count);
        aR.Handle := hRadio;
        aR.NameFriendly := stInf.szName;
        aR.Address := stInf.address;
        lRadios.Add(aR);
      end;
    until not BluetoothFindNextRadio(hFind, hRadio);

    {$IFDEF TRIAL}
    cnt_alrt;
    {$ENDIF}

    BluetoothFindRadioClose(hFind);
  end;
end;

function TnrBT.GetDeviceEnum: TnrBtDeviceEnumerate;
begin
  Result := fDeviceEnum;
end;

procedure TnrBT.SetDeviceEnum(const Value: TnrBtDeviceEnumerate);
begin
  if fDeviceEnum <> Value then begin
    fDeviceEnum := Value;
  end;
end;

function TnrBT.GetDeviceEnumTimeout: integer;
begin
  Result := fDeviceEnumTimeout;
end;

procedure TnrBT.SetDeviceEnumTimeout(const Value: integer);
begin
  fDeviceEnumTimeout := Value;
  if Value < 0 then fDeviceEnumTimeout := 0;
  if Value > 57 then fDeviceEnumTimeout := 57;
end;

procedure TnrBT.ConfigDialog;
begin
  if(RadioIndex >= 0) and (fDeviceIndex >= 0) then begin
    BluetoothDisplayDeviceProperties(GetMainWindowHandle, Device[fDeviceIndex].btInfo);
  end;
end;

function TnrBT.SelectDeviceDialog(sInfo:WideString; flForceAuth, flAddWiz, flSkipServices:boolean): boolean;
var par:BLUETOOTH_SELECT_DEVICE_PARAMS;
    err:dword;
begin
  Result := False;
  FillChar(par, SizeOf(BLUETOOTH_SELECT_DEVICE_PARAMS), 0);
  par.dwSize := SizeOf(BLUETOOTH_SELECT_DEVICE_PARAMS);
  par.fShowAuthenticated := bteAuthenticated in fDeviceEnum;
  par.fShowRemembered := bteRemembered in fDeviceEnum;
  par.fShowUnknown := bteUnknown in fDeviceEnum;
  par.fForceAuthentication := flForceAuth;
  par.fAddNewDeviceWizard := flAddWiz;
  par.fSkipServicesPage := flSkipServices;
  par.hwndParent := GetMainWindowHandle;// GetTopWindow(0);
  if sInfo <> '' then par.pszInfo := PWideChar(sInfo);
  if BluetoothSelectDevices(par) then
  begin
    DeviceIndex := GetDeviceIndexByAddress(par.pDevices.Address);
    BluetoothSelectDevicesFree(par);
    Result := DeviceIndex >= 0;
  end else begin
    err := GetLastError;
    if err <> ERROR_CANCELLED
      then  DoFatalErrors(ECC_BT, err, 'Bluetooth select device dialog fails with error: [' + IntToHex(err,8) +'] ' + SysErrorMessage(GetLastError), False) ;
  end;
end;

function TnrBT.GetReadyForRead: cardinal;
var i:integer;
begin
  i := 0;
  if IsHandleValid then ioctlsocket(Handle,FIONREAD,i);
  Result := i;
end;

procedure TnrBT.SetBlockMode(flBlock: boolean);
var i:integer;
begin
  i := Integer(not flBlock);
  ioctlsocket(Handle,FIONBIO,i);
end;

procedure TnrBT.SendChar(const Ch: Char);
var b:byte;
begin
  if IsHandleValid then begin
    SetBlockMode(True);
    b := Byte(Ch);
    send(Handle, b, 1, 0);
  end;
end;

procedure TnrBT.SendString(const S: AnsiString);
var b:PAnsiChar;
begin
  if IsHandleValid then begin
    b := PAnsiChar(s);
    SetBlockMode(True);
    send(Handle, b^, Length(s), 0);
  end;
end;

procedure TnrBT.SendData(const Buff: PAnsiChar; const N: cardinal);
begin
  if IsHandleValid then begin
    SetBlockMode(False);
//    TnrBTThread.Create(Self, True, OnSentData);
    send(Handle, Buff^, N, 0);
  end;
end;

procedure TnrBT.Read(Buffer: PChar; Len: cardinal);
begin
  if IsHandleValid then begin
    SetBlockMode(True);
    recv(Handle,Buffer^,Len,0);
  end;
end;

procedure TnrBT.ReadAll(Buffer: PChar);
begin
  Read(Buffer,ReadyForRead);
end;

function TnrBT.ReadString: string;
var n:cardinal;
begin
  n := GetReadyForRead;
  SetLength(Result,n);
  if n > 0 then Read(PChar(Result), n);
end;

procedure TnrBT.OnReceiveData(aSender: TObject);
var sz:cardinal;
    flReadNeeded : boolean;
    Igt:TIgnoreTypes;
begin
  sz := ReadyForRead;
  Inc(edx, sz);
  if sz = 0 then begin
    TThread(aSender).Terminate;
    Close;
  end
   else begin

     flReadNeeded := (Assigned(fOnAfterReceive)
           or Assigned(DataProcessor)
           {$IFDEF NR_WITH_CONTROLS}
           or Assigned(Terminal)
           {$ENDIF}
           );

     if flReadNeeded and (not flDontRead) then begin
       SetBlockMode(True);
       recv(Handle,fBuffer^,sz,0);
       Igt := [];
       if Assigned(DataProcessor)
         then DataProcessor.DoProcessing(fBuffer,sz,Igt);
       {$IFDEF NR_WITH_CONTROLS}
       if Assigned(Terminal) and (not(itTerminal in  Igt))
         then UpdateTerminalByChars(fBuffer,sz);
       {$ENDIF}
       if (not(itAfterReceive in  Igt)) and Assigned(fOnAfterReceive)
         then fOnAfterReceive(Self,fBuffer,sz);

     end;
   end;
end;

procedure TnrBT.OnSentData(aSender: TObject);
begin
  TThread(aSender).Terminate;
  if Assigned(fOnAfterSend) then fOnAfterSend(Self);
end;

function TnrBT.GetOnReceived: TOnReceived;
begin
  Result :=  fOnAfterReceive;
end;

procedure TnrBT.SetOnReceived(const Value: TOnReceived);
begin
  fOnAfterReceive := Value;
end;

function TnrBT.GetOnSent: TOnSent;
begin
  Result := fOnAfterSend;
end;

procedure TnrBT.SetOnSent(const Value: TOnSent);
begin
  fOnAfterSend := Value;
end;

function TnrBT.GetBufferInSize: integer;
begin
  Result := fBufferInSize;
end;

function TnrBT.GetBufferOutSize: integer;
begin
  Result := fBufferOutSize;
end;

procedure TnrBT.SetBufferInSize(const Value: integer);
begin
  if fBufferInSize <> Value then begin
    fBufferInSize := Value;
    UpdateInternalBuffer;
    if IsHandleValid
      then setsockopt(Handle,SOL_SOCKET,SO_RCVBUF,@fBufferInSize,4);
  end;
end;

procedure TnrBT.SetBufferOutSize(const Value: integer);
begin
  if fBufferOutSize <> Value then begin
    fBufferOutSize := Value;
    if IsHandleValid
      then setsockopt(Handle,SOL_SOCKET,SO_SNDBUF,@fBufferOutSize,4);
  end;
end;

procedure TnrBT.BufferSizeUpdate;
var rs,sz:integer;
begin
  if IsHandleValid then begin
    sz := 4;
    getsockopt(Handle,SOL_SOCKET,SO_RCVBUF,@rs,sz);
    if rs <> fBufferInSize then begin
      fBufferInSize := rs;
      UpdateInternalBuffer;
    end;
    getsockopt(Handle,SOL_SOCKET,SO_SNDBUF,@fBufferOutSize,sz);
  end;
end;

procedure TnrBT.UpdateInternalBuffer;
begin
  if fBuffer <> nil then LocalFree(Cardinal(fBuffer));
  fBuffer := PAnsiChar(LocalAlloc(LPTR, fBufferInSize));
end;

function TnrBT.WaitForBytes(Count, Ms: cardinal): boolean;
begin
  Result:=False;
  if not IsHandleValid then exit;
  flDontRead := True;
  Ms := Ms + GetTickCount();
  while (ms >= GetTickCount()) and IsHandleValid do begin
    Result := Boolean(GetReadyForRead>=Count);
    if Result then break;
    sleep(1);
    {$IFDEF NR_WITH_CONTROLS}
    if Assigned(Application) then Application.ProcessMessages;
    {$ENDIF}
  end;
  flDontRead := False;
end;

function TnrBT.AuthenticateDevice(const passKey: WideString): boolean;
var len:DWORD;
    pwcKey:PWideChar;
begin  // thanks to Andrei Skatchkov <AS@somnomedics.de>
  Result := False;
  if (RadioIndex >= 0) and (fDeviceIndex >= 0) then begin
    len := Length(passKey);
    if len > 0
      then pwcKey := PWideChar(passKey)
      else pwcKey := nil;
    Result :=  ERROR_SUCCESS = BluetoothAuthenticateDevice(GetMainWindowHandle, Radio[RadioIndex].Handle, Device[fDeviceIndex].btInfo, pwcKey, len);
  end;
end;

initialization

finalization
{$IFDEF TRIAL}
  cnt_alrt;
{$ENDIF}


end.
