hidcontrollerclass.pas

Componente para Tratar USB

      end;
    if HidDev <> nil then
    begin
      HidDev.DoUnplug;
      // prepare for deletion from list
      if not HidDev.IsCheckedOut then
        FList.Items[I] := nil;
      Changed := True;
    end;
  end;

  // delete the nil elements from FList
  I := 0;
  while I < FList.Count do
  begin
    if FList.Items[I] = nil then
      FList.Delete(I)
    else
      Inc(I);
  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]).DeviceID = TJvHidDevice(FList[J]).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;
    end;

  // throw away helper list
  NewList.Free;

  // recount the devices
  FNumCheckedInDevices  := 0;
  FNumCheckedOutDevices := 0;
  FNumUnpluggedDevices  := 0;
  for I := 0 to FList.Count - 1 do
  begin
    HidDev := FList.Items[I];
    Inc(FNumCheckedInDevices,  Ord(not HidDev.IsCheckedOut));
    Inc(FNumCheckedOutDevices, Ord(HidDev.IsCheckedOut));
    Inc(FNumUnpluggedDevices,  Ord(not HidDev.IsPluggedIn));
  end;
  FNumCheckedOutDevices := FNumCheckedOutDevices - FNumUnpluggedDevices;

  if Assigned(FDeviceChangeEvent) and Changed then
    FDeviceChangeEvent(Self);
end;

// assign OnDeviceChange and immediately fire if needed

procedure TJvHidDeviceController.SetDeviceChangeEvent(const Notifier: TNotifyEvent);
begin
  if @Notifier <> @FDeviceChangeEvent then
  begin
    FDeviceChangeEvent := Notifier;
    if Assigned(FDeviceChangeEvent) and not FDeviceChangeFired then
      FDeviceChangeEvent(Self);
    FDeviceChangeFired := True;
  end;
end;

// implement OnEnumerate event

function TJvHidDeviceController.DoEnumerate(HidDev: TJvHidDevice; Idx: Integer): Boolean;
begin
  Result := False;
  if Assigned(FEnumerateEvent) then
  begin
    HidDev.FIsEnumerated := True;
    Result := FEnumerateEvent(HidDev, Idx);
    HidDev.FIsEnumerated := False;
    if not HidDev.FIsCheckedOut then
    begin
      HidDev.CloseFile;
      HidDev.CloseFileEx;
    end;
  end;
end;

// assign OnEnumerate event

procedure TJvHidDeviceController.SetEnumerate(const Enumerator: TJvHidEnumerateEvent);
begin
  if @Enumerator <> @FEnumerateEvent then
    FEnumerateEvent := Enumerator;
end;

// assign OnDevUnplug event

procedure TJvHidDeviceController.SetDevUnplug(const Unplugger: TJvHidUnplugEvent);
var
   I:   Integer;
   Dev: TJvHidDevice;
begin
  if @Unplugger <> @FDevUnplugEvent then
  begin
    // change all OnUnplug events with the same old value
    if not (csDesigning in ComponentState) then
      for I := 0 to FList.Count - 1 do
      begin
        Dev := FList.Items[I];
        if @Dev.FUnplug = @FDevUnplugEvent then
          Dev.OnUnplug := Unplugger;
      end;
    FDevUnplugEvent := Unplugger;
  end;
end;

// send an OnEnumerate event for ALL controlled HidDevices
// it is explicitly allowed to check out any device in the event

function TJvHidDeviceController.Enumerate: Integer;
var
   I: Integer;
begin
  Result := 0;
  for I := 0 to FList.Count - 1 do
    if TJvHidDevice(FList[I]).IsPluggedIn then
    begin
      Inc(Result);
      if not DoEnumerate(FList[I], I) then
        Break;
    end;
end;

//-- TJvHidDeviceController methods -----------------------------------

// internal worker function to check out a TJvHidDevice

function TJvHidDeviceController.CheckThisOut(var HidDev: TJvHidDevice; Idx: Integer; Check: Boolean): Boolean;
begin
  Result := Check and not TJvHidDevice(FList.Items[Idx]).IsCheckedOut;
  if Result then
  begin
    HidDev := FList[Idx];
    HidDev.FIsCheckedOut := True;
    Inc(FNumCheckedOutDevices);
    Dec(FNumCheckedInDevices);
  end;
end;

// method CheckOutByProductName hands out the first HidDevice with a matching ProductName

function TJvHidDeviceController.CheckOutByProductName(var HidDev: TJvHidDevice; ProductName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  HidDev := nil;
  if ProductName <> '' then
    for I := 0 to FList.Count - 1 do
    begin
      Result := CheckThisOut(HidDev, I, ProductName = TJvHidDevice(FList[I]).ProductName);
      if Result then
        Break;
    end;
end;

// method CheckOutByVendorName hands out the first HidDevice with a matching VendorName

function TJvHidDeviceController.CheckOutByVendorName(var HidDev: TJvHidDevice; VendorName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  HidDev := nil;
  if VendorName <> '' then
    for I := 0 to FList.Count - 1 do
    begin
      Result := CheckThisOut(HidDev, I, VendorName = TJvHidDevice(FList[I]).VendorName);
      if Result then
        Break;
    end;
end;

// method CheckOutByClass hands out the first HidDevice with a matching Class
// Class comes from the registry (examples: 'Mouse', 'Keyboard')

function TJvHidDeviceController.CheckOutByClass(var HidDev: TJvHidDevice; ClassName: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  HidDev := nil;
  if ClassName <> '' then
    for I := 0 to FList.Count - 1 do
    begin
      Result := CheckThisOut(HidDev, I, ClassName = TJvHidDevice(FList[I]).RegClass);
      if Result then
        Break;
    end;
end;

// method CheckOutByID hands out the first HidDevice with a matching VendorID and ProductID
// Pid = -1 matches all ProductIDs

function TJvHidDeviceController.CheckOutByID(var HidDev: TJvHidDevice; Vid, Pid: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  HidDev := nil;
  for I := 0 to FList.Count - 1 do
  begin
    Result := CheckThisOut(HidDev, I, (Vid = TJvHidDevice(FList[I]).Attributes.VendorID) and
      ((Pid = TJvHidDevice(FList[I]).Attributes.ProductID) or (Pid = -1)));
    if Result then
      Break;
  end;
end;

// method CheckOutByIndex hands out the HidDevice in the list with the named index
// this is mainly for check out during OnEnumerate

function TJvHidDeviceController.CheckOutByIndex(var HidDev: TJvHidDevice; const Idx: Integer): Boolean;
begin
  Result := False;
  HidDev := nil;
  if (Idx >= 0) and (Idx < FList.Count) then
    Result := CheckThisOut(HidDev, Idx, True);
end;

// method CheckOut simply hands out the first available HidDevice in the list

function TJvHidDeviceController.CheckOut(var HidDev: TJvHidDevice): Boolean;
var
  I: Integer;
begin
  Result := False;
  HidDev := nil;
  for I := 0 to FList.Count - 1 do
  begin
    Result := CheckThisOut(HidDev, I, True);
    if Result then
      Break;
  end;
end;

// method CheckIn hands a checked out HidDevice back in

procedure TJvHidDeviceController.CheckIn(var HidDev: TJvHidDevice);
begin
  if HidDev <> nil then
  begin
    HidDev.CloseFile;
    HidDev.CloseFileEx;

    if HidDev.IsPluggedIn then
    begin
      HidDev.FIsCheckedOut := False;
      Dec(FNumCheckedOutDevices);
      Inc(FNumCheckedInDevices);
    end
    else
      HidDev.Free;
    HidDev := nil;
  end;
end;

// a helper function to check the return values just 
// like Win32Check
// the functions return the parameter to be transparent

function HidCheck(const RetVal: NTSTATUS): NTSTATUS;
begin
  if RetVal <> HIDP_STATUS_SUCCESS then
    HidError(RetVal);
  Result := RetVal;
end;

function HidCheck(const RetVal: LongBool): LongBool;
begin
  if not RetVal then
    raise EHidClientError.Create('HidClient Error: a boolean function failed');
  Result := RetVal;
end;

function HidError(const RetVal: NTSTATUS): NTSTATUS;
var
  ErrBuf: string;
begin
  // only check HID errors
  if ((RetVal and NTSTATUS($00FF0000)) = HIDP_STATUS_SUCCESS) and
     ((RetVal and NTSTATUS($C0000000)) <> 0) then
  begin
    case RetVal of
      HIDP_STATUS_NULL:                    ErrBuf := 'device not plugged in';
      HIDP_STATUS_INVALID_PREPARSED_DATA:  ErrBuf := 'invalid preparsed data';
      HIDP_STATUS_INVALID_REPORT_TYPE:     ErrBuf := 'invalid report type';
      HIDP_STATUS_INVALID_REPORT_LENGTH:   ErrBuf := 'invalid report length';
      HIDP_STATUS_USAGE_NOT_FOUND:         ErrBuf := 'usage not found';
      HIDP_STATUS_VALUE_OUT_OF_RANGE:      ErrBuf := 'value out of range';
      HIDP_STATUS_BAD_LOG_PHY_VALUES:      ErrBuf := 'bad logical or physical values';
      HIDP_STATUS_BUFFER_TOO_SMALL:        ErrBuf := 'buffer too small';
      HIDP_STATUS_INTERNAL_ERROR:          ErrBuf := 'internal error';
      HIDP_STATUS_I8042_TRANS_UNKNOWN:     ErrBuf := '8042 key translation impossible';
      HIDP_STATUS_INCOMPATIBLE_REPORT_ID:  ErrBuf := 'incompatible report ID';
      HIDP_STATUS_NOT_VALUE_ARRAY:         ErrBuf := 'not a value array';
      HIDP_STATUS_IS_VALUE_ARRAY:          ErrBuf := 'is a value array';
      HIDP_STATUS_DATA_INDEX_NOT_FOUND:    ErrBuf := 'data index not found';
      HIDP_STATUS_DATA_INDEX_OUT_OF_RANGE: ErrBuf := 'data index out of range';
      HIDP_STATUS_BUTTON_NOT_PRESSED:      ErrBuf := 'button not pressed';
      HIDP_STATUS_REPORT_DOES_NOT_EXIST:   ErrBuf := 'report does not exist';
      HIDP_STATUS_NOT_IMPLEMENTED:         ErrBuf := 'not implemented';
    else
      ErrBuf := Format('unknown HID error %x', [RetVal]);
    end;
    raise EHidClientError.Create('HidClient Error: ' + ErrBuf);
  end;
  Result := RetVal;
end;

procedure Register;
begin
  RegisterComponents('Babak', [TJvHidDeviceController]);
end;

end.