• Welcome to Forum.Deepsoftware.Com. Please login or sign up.
 

Sample Delphi Function using nrComm Lib HID solution

Started by Thomas, October 05, 2011, 03:30:00 pm

Previous topic - Next topic

Thomas

//  myHidIndex:=GetHidDevice(<VendorId>, <ProductId>, <FriendlyName>);
// 
//  Returns -1 if no Hid device active or hid index number if active
//
//  This program uses 1 ListBox (DevListBox), 1 History ListBox (HistoryListBox) for HexStrings
//  and a memo (meResults) for hex to Ascii 

Function GetHidDevice(Vid, Pid, Fname: String): integer;
Var
   FriendlyName : string;
   VendorID : string;
   ProductID : string;
   FoundHid : Boolean;
   HIdIndexNo : integer;

Begin
  nrHid1.Update;             
  nrHid1.Active:=False;
  FrmTaylorEditTest.nrHid2.Active:=False;

  if nrHid1.DeviceCount=0 then
    Begin
     Result:=-1;
     Exit;
    End;
 
  HIdIndexNo:=0;
  FoundHid:=False;
 
  repeat         
    nrHid1.UpdateDeviceDetails;
    FriendlyName:=nrHid1.Device[HIdIndexNo].NameFriendly;       
    VendorID:=IntToHex(nrHid1.HidDevice.VendorID, 4);   
    ProductID:=IntToHex(nrHid1.HidDevice.ProductID, 4);

    if VendorID=Vid then FoundHid:=True;
    if ProductID=Pid then FoundHid:=True;
    if FriendlyName=Fname then FoundHid:=True;
    if FoundHid=True then break;

    HIdIndexNo:=HIdIndexNo+1;
    nrHid1.DeviceIndex:=HIdIndexNo;
  until HIdIndexNo = nrHid1.DeviceCount;
   
  if FoundHid=True then
     begin
       DevListBox.Clear;     
       DevListBox.Items.Add('Product Name -- '+ nrHid1.HidDevice.NameFriendly);
       DevListBox.Items.Add('Manufacturer -- '+ nrHid1.HidDevice.Manufacturer);
       DevListBox.Items.Add('Description  -- '+ nrHid1.HidDevice.Description);
       DevListBox.Items.Add('Service      -- '+ nrHid1.HidDevice.Service);
       DevListBox.Items.Add('VendorID     -- '+ IntToHex(nrHid1.HidDevice.VendorID, 4));
       DevListBox.Items.Add('ProductID    -- '+ IntToHex(nrHid1.HidDevice.ProductID, 4));
       DevListBox.Items.Add('S/N          -- '+ nrHid1.HidDevice.SerialNumber);
       DevListBox.Items.Add('Ver          -- '+ IntToStr(nrHid1.HidDevice.Version) + ' [' + IntToHex(nrHid1.HidDevice.Version, 4) + 'h]');
       DevListBox.Items.Add('Usage Page   -- '+ IntToHex(nrHid1.HidDevice.UsagePage, 4) + ' (' + GetUsagePageString(nrHid1.HidDevice.UsagePage) + ')');
       DevListBox.Items.Add('I/O Length   -- '+ IntToStr(nrHid1.HidDevice.InputReportLength) + '/' + IntToStr(nrHid1.HidDevice.OutputReportLength));

       Try
         nrHid1.DeviceIndex:=HIdIndexNo;
         nrHid1.Active:=True;
       Except
         nrHid1.Active:=False;
         HIdIndexNo:=-1;
       End;
       
       if nrHid1.Active then
         begin
           DevListBox.Items.Add('R/W modes    -- '+ BoolToStr(nrHid1.IsReadMode,True) + ' / ' + BoolToStr(nrHid1.IsWriteMode,True));
         end;
     end
   Else  // FoundHid=False
     HIdIndexNo:=-1;
     
  Result:=HIdIndexNo;
End;



procedure nrHid1AfterReceive(Com: TObject; Buffer: Pointer;
  Received: Cardinal);
  var
    I: Integer;
    Str: string;
    HasFound : boolean;
begin
  if myHidIndex=-1 then exit;  // no Hid found

  Str := '';
  for i := 0 to Received - 1
    do Str := Str + IntToHex(Byte(PAnsiChar(Buffer)),2) + ' ';

  HistoryListBox.ItemIndex := HistoryListBox.Items.Add(Str);
  if pos('91 45 6E 64 4F 66', HistoryListBox.Items.Text)>0 then // end of test string sent
    Begin
      btDecodeClick;
    End;

End;


// decode hex to ascii
procedure btDecodeClick;
var
  sListEncoded: TStringList;
  sListDecoded: TStringList;
  FileSpec: string;
begin
  meResults.Clear;
  sListEncoded := TStringList.Create;
  sListDecoded := TStringList.Create;
  try
    sListEncoded.Text:=HistoryListBox.Items.Text;
    {*******************************************************}
    DecodeHexStrings(sListEncoded, 7, 1, '0F', sListDecoded);
    {*******************************************************}
    meResults.Lines.Text := sListDecoded.Text;
  except
    on e:Exception do
    begin
      ShowMessage(E.Message);
    end;
  end;
  FreeAndNil(sListDecoded);
  FreeAndNil(sListEncoded);
end;

Roman Novgorodov

Hello

Thank you for post with sample code.

Roman Novgorodov
DeepSoftware LLC
DeepSoftware llc - The professional components for Delphi/CBuilder/.NET. The high quality custom software development.
Forums.nrCommLib.Com - DeepSoftware Tech Support Forum.