jvhidcontrollerclass.pas

HID controller package containing sources and help

function TJvHidDevice.SetUsageValue(UsageValue: ULONG; var Report; ReportLength: ULONG): NTSTATUS;
begin
  Result := HIDP_STATUS_NULL; // for not plugged in
  if IsAccessible then
    Result := HidP_SetUsageValue(ReportTypeParam, UsagePageParam, LinkCollectionParam,
      UsageParam, UsageValue, PreparsedData, Report, ReportLength);
end;

function TJvHidDevice.SetScaledUsageValue(UsageValue: Integer; var Report;
  ReportLength: ULONG): NTSTATUS;
begin
  Result := HIDP_STATUS_NULL; // for not plugged in
  if IsAccessible then
    Result := HidP_SetScaledUsageValue(ReportTypeParam, UsagePageParam, LinkCollectionParam,
      UsageParam, UsageValue, PreparsedData, Report, ReportLength);
end;

function TJvHidDevice.SetUsageValueArray(UsageValue: PChar;
  UsageValueByteLength: WORD; var Report; ReportLength: ULONG): NTSTATUS;
begin
  Result := HIDP_STATUS_NULL; // for not plugged in
  if IsAccessible then
    Result := HidP_SetUsageValueArray(ReportTypeParam, UsagePageParam, LinkCollectionParam,
      UsageParam, UsageValue, UsageValueByteLength, PreparsedData, Report, ReportLength);
end;

function TJvHidDevice.DeviceIoControl(IoControlCode: DWORD; InBuffer: Pointer; InSize: DWORD;
  OutBuffer: Pointer; OutSize: DWORD; var BytesReturned: DWORD): Boolean;
begin
  Result := False;
  if OpenFile then
    Result := Windows.DeviceIoControl(HidFileHandle, IoControlCode, InBuffer, InSize,
      OutBuffer, OutSize, BytesReturned, nil);
end;

function TJvHidDevice.ReadFile(var Report; ToRead: DWORD; var BytesRead: DWORD): Boolean;
begin
  Result := False;
  if OpenFile then
    Result := Windows.ReadFile(HidFileHandle, Report, ToRead, BytesRead, nil);
end;

function TJvHidDevice.WriteFile(var Report; ToWrite: DWORD; var BytesWritten: DWORD): Boolean;
begin
  Result := False;
  if OpenFile then
    Result := Windows.WriteFile(HidFileHandle, Report, ToWrite, BytesWritten, nil);
end;

// the TOverlapped structure is not needed externally
// the hEvent element is used to transport the device object
// to the callback function
// Better not implement a Delphi event with that

function TJvHidDevice.ReadFileEx(var Report; ToRead: DWORD;
  CallBack: TPROverlappedCompletionRoutine): Boolean;
begin
  Result := False;
  if OpenFileEx(omhRead) then
  begin
    FillChar(FOvlRead, SizeOf(TOverlapped), #0);
    FOvlRead.hEvent := DWORD(Self);
    Result := JvHidControllerClass.ReadFileEx(HidOverlappedRead, Report, ToRead, FOvlRead, CallBack);
  end;
end;

function TJvHidDevice.WriteFileEx(var Report; ToWrite: DWORD;
  CallBack: TPROverlappedCompletionRoutine): Boolean;
begin
  Result := False;
  if OpenFileEx(omhWrite) then
  begin
    FillChar(FOvlWrite, SizeOf(TOverlapped), #0);
    FOvlWrite.hEvent := DWORD(Self);
    Result := JvHidControllerClass.WriteFileEx(HidOverlappedWrite, Report, ToWrite, FOvlWrite, CallBack);
  end;
end;

function TJvHidDevice.CheckOut: Boolean;
begin
  Result := Assigned(FMyController) and IsPluggedIn and not IsCheckedOut;
  if Result then
  begin
    FIsCheckedOut := True;
    Inc(FMyController.FNumCheckedOutDevices);
    Dec(FMyController.FNumCheckedInDevices);
    StartThread;
  end;
end;

function  TJvHidDevice.GetExtendedAttributes(ReportType: THIDPReportType; DataIndex: Word;
  Attributes: PHIDPExtendedAttributes; var LengthAttributes: ULONG): NTSTATUS;
begin
  if Assigned(HidP_GetExtendedAttributes) then
    Result := HidP_GetExtendedAttributes(ReportType, DataIndex, FPreparsedData,
      Attributes, LengthAttributes)
  else
    Result := HIDP_STATUS_NOT_IMPLEMENTED;
end;

function TJvHidDevice.InitializeReportForID(ReportType: THIDPReportType; ReportID: Byte;
  var Report; ReportLength: ULONG): NTSTATUS;
begin
  if Assigned(HidP_InitializeReportForID) then
    Result := HidP_InitializeReportForID(ReportType, ReportID, FPreparsedData, Report, ReportLength)
  else
    Result := HIDP_STATUS_NOT_IMPLEMENTED;
end;

function TJvHidDevice.GetInputReport(var Report; const Size: ULONG): Boolean;
begin
  Result := False;
  if Assigned(HidD_GetInputReport) then
    if OpenFile then
      Result := HidD_GetInputReport(FHidFileHandle, @Report, Size);
end;

function TJvHidDevice.SetOutputReport(var Report; const Size: ULONG): Boolean;
begin
  Result := False;
  if Assigned(HidD_SetOutputReport) then
    if OpenFile then
      Result := HidD_SetOutputReport(FHidFileHandle, @Report, Size);
end;

//=== { TJvHidDeviceController } =============================================

constructor TJvHidDeviceController.Create(AOwner: TComponent);
const
  cHidGuid: TGUID = '{4d1e55b2-f16f-11cf-88cb-001111000030}';
begin
  inherited Create(AOwner);
  FDeviceChangeEvent := nil;
  FEnumerateEvent := nil;
  FDevUnplugEvent := nil;
  FNumCheckedInDevices := 0;
  FNumCheckedOutDevices := 0;
  FNumUnpluggedDevices := 0;
  FDevThreadSleepTime := 100;
  FVersion := cHidControllerClassVersion;
  FInDeviceChange := False;

  FList := TList.Create;

  if LoadSetupApi then
    LoadHid;
  if IsHidLoaded then
  begin
    HidD_GetHidGuid(FHidGuid);
    // only hook messages if there is a HID DLL
    FHWnd := AllocateHWnd(EventPipe);
    // this one executes after Create completed which ensures
    // that all global elements like Application.MainForm are initialized
    PostMessage(FHWnd, WM_DEVICECHANGE, DBT_DEVNODES_CHANGED, -1);
  end
  else
    FHidGuid := cHidGuid;
end;

// unplug or kill all controlled TJvHidDevices on controller destruction

destructor TJvHidDeviceController.Destroy;
var
  I: Integer;
  HidDev: TJvHidDevice;
begin
  // to prevent strange problems
  FDeviceChangeEvent := nil;
  FDevUnplugEvent := nil;
  OnEnumerate := nil;
  // unhook event pipe
  if IsHidLoaded then
    DeallocateHWnd(FHWnd);

  for I := 0 to FList.Count - 1 do
  begin
    HidDev := FList.Items[I];
    with HidDev do
    begin
      // set to uncontrolled
      FMyController := nil;
      if IsCheckedOut then
        DoUnplug // pull the plug for checked out TJvHidDevices
      else
        Free; // kill TJvHidDevices which are not checked out
    end;
  end;
  FList.Free;

  if IsHidLoaded then
    UnloadSetupApi;
  UnloadHid;

  inherited Destroy;
end;

procedure TJvHidDeviceController.DoArrival(HidDev: TJvHidDevice);
begin
  if Assigned(FArrivalEvent) then
  begin
    HidDev.FIsEnumerated := True;
    FArrivalEvent(HidDev);
    HidDev.FIsEnumerated := False;
  end;
end;

procedure TJvHidDeviceController.DoRemoval(HidDev: TJvHidDevice);
begin
  if Assigned(FRemovalEvent) then
  begin
    HidDev.FIsEnumerated := True;
    FRemovalEvent(HidDev);
    HidDev.FIsEnumerated := False;
  end;
end;

// implement OnDeviceChange event

procedure TJvHidDeviceController.DoDeviceChange;
begin
  if Assigned(FDeviceChangeEvent) then
    FDeviceChangeEvent(Self);
end;

// gets all the Windows events/messages directly

procedure TJvHidDeviceController.EventPipe(var Msg: TMessage);
begin
  // sort out WM_DEVICECHANGE : DBT_DEVNODES_CHANGED
  if (Msg.Msg = WM_DEVICECHANGE) and (TWMDeviceChange(Msg).Event = DBT_DEVNODES_CHANGED) then
    if not FInDeviceChange then
    begin
      FLParam := Msg.LParam;
      FInDeviceChange := True;
      DeviceChange;
      FInDeviceChange := False;
    end;
  Msg.Result := DefWindowProc(FHWnd, Msg.Msg, Msg.wParam, Msg.lParam);
end;

// implements OnDeviceChange event
// it is published to allow calling at design time

procedure TJvHidDeviceController.DeviceChange;
var
  I: Integer;
  J: Integer;
  HidDev: TJvHidDevice;
  Changed: Boolean;
  NewList: TList;

  // internal worker function to find all HID devices and create their objects

  procedure FillInList;
  var
    PnPHandle: HDEVINFO;
    DevData: TSPDevInfoData;
    DeviceInterfaceData: TSPDeviceInterfaceData;
    FunctionClassDeviceData: PSPDeviceInterfaceDetailDataA;
    Success: LongBool;
    Devn: Integer;
    BytesReturned: DWORD;
    HidDev: TJvHidDevice;
    PnPInfo: TJvHidPnPInfo;
  begin
    if not IsHidLoaded then
      Exit;

    // Get a handle for the Plug and Play node and request currently active HID devices
    PnPHandle := SetupDiGetClassDevs(@FHidGuid, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
    if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
      Exit;
    Devn := 0;
    repeat
      DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
      // Is there a HID device at this table entry?
      Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, FHidGuid, Devn, DeviceInterfaceData);
      if Success then
      begin
        DevData.cbSize := SizeOf(DevData);
        BytesReturned := 0;
        SetupDiGetDeviceInterfaceDetailA(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
        if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
        begin
          FunctionClassDeviceData := AllocMem(BytesReturned);
          FunctionClassDeviceData^.cbSize := SizeOf(TSPDeviceInterfaceDetailDataA);
          if SetupDiGetDeviceInterfaceDetailA(PnPHandle, @DeviceInterfaceData,
            FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
          begin
            // fill in PnPInfo of device
            PnPInfo := TJvHidPnPInfo.Create(PnPHandle, DevData, PChar(@FunctionClassDeviceData.DevicePath));
            // create HID device object and add it to the device list
            try
              HidDev := TJvHidDevice.CtlCreate(PnPInfo, Self);
              NewList.Add(HidDev);
            except
              // ignore device if unreadable
            end;
            Inc(Devn);
          end;
          FreeMem(FunctionClassDeviceData);
        end;
      end;
    until not Success;
    SetupDiDestroyDeviceInfoList(PnPHandle);
  end;

begin
  // initial auto message always triggers OnDeviceChange event
  Changed := (FLParam = -1);
  // get new device list
  NewList := TList.Create;
  FillInList;

  // unplug devices in FList which are not in NewList
  for I := FList.Count - 1 downto 0 do
  begin
    HidDev := FList.Items[I];
    for J := NewList.Count - 1 downto 0 do
      if (TJvHidDevice(NewList.Items[J]).PnPInfo.DeviceID = HidDev.PnPInfo.DeviceID) and
        HidDev.IsPluggedIn then
      begin
        HidDev := nil;
        Break;
      end;
    if HidDev <> nil then
    begin
      HidDev.DoUnplug;
      DoRemoval(HidDev);
      // delete from list
      if not HidDev.IsCheckedOut then
        FList.Delete(I);
      Changed := True;
    end;
  end;

  // delete devices from NewList which are in FList
  for I := 0 to NewList.Count - 1 do
    for J := 0 to FList.Count - 1 do
      if (TJvHidDevice(NewList[I]).PnPInfo.DeviceID = TJvHidDevice(FList[J]).PnPInfo.DeviceID) and
        TJvHidDevice(FList[J]).IsPluggedIn then
      begin
        TJvHidDevice(NewList[I]).FMyController := nil; // prevent Free/Destroy from accessing this controller
        TJvHidDevice(NewList[I]).Free;
        NewList[I] := nil;
        Break;
      end;

  // add the remains in NewList to FList
  for I := 0 to NewList.Count - 1 do
    if NewList[I] <> nil then
    begin
      FList.Add(NewList[I]);
      Changed := True;
      DoArrival(TJvHidDevice(NewList[I]));
    end;

  // throw away helper list
  NewList.Free;

  // recount the devices
  FNumCheckedInDe