I made a small program in Delphi 7 to show some details of all attached HID devices. I only used system files like SetupAPI
, Moduleloader
and HID.pas
. This works perfect.
When I take the same code and compile it in Delphi XE2 or (2010 for that matter), it fails to produce the required output.
Probably this has something to do with pointer casting or so, but I cannot find the root cause.
Can anyone help.
This is my code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
Uses
SetUpAPI, HID;
{$R *.dfm}
Type
THIDUSBDeviceInfo = Record { contains interface level information of each device}
SymLink : String;
BufferSize : Word;
Handle : THandle;
VID : DWord;
PID : DWord;
VersionNumber : Word;
ManufacturerString : String;
ProductString : String;
SerialNumberString : String;
end;
THIDDeviceList = Array of THIDUSBDeviceInfo;
Const
HIDUSB_COUNTOFINTERRUPTBUFFERS = 64; // Count of buffers for interrupt data
Procedure ScanForHIDdevices( Var DeviceList : THIDDeviceList;
TargetVID, TargetPID : DWord);
Var
HID_GUIid : TGUID;
spdid : TSPDeviceInterfaceData;
pSpDidd : PSPDEVICEINTERFACEDETAILDATAA;
spddd : TSPDevInfoData;
HIDinfo : HDEVINFO;
CurIdx : Integer;
dwSize : DWord;
SymbolicLink : String;
DevHandle : THandle;
HidAttrs : THIDDAttributes;
FoundIdx : Integer;
Info : THIDUSBDeviceInfo;
Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
Var
pstr : pWideChar;
preparsedData : PHIDPPreparsedData;
hidCaps : THIDPCaps;
Begin
FillChar(Result, SizeOf( Result), 0);
Result.SymLink := SymLink+ #0;
GetMem( pstr, 512);
DevHandle := CreateFile( Symlink,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
If DevHandle <> INVALID_HANDLE_VALUE then
begin
If HidD_GetAttributes( DevHandle,
HidAttrs) then
begin
result.VID := HidAttrs.VendorID;
result.PID := HidAttrs.ProductID;
result.VersionNumber := HidAttrs.VersionNumber;
end;
If HidD_GetManufacturerString( DevHandle, pstr, 512) then
Result.ManufacturerString := pStr;
If HidD_GetProductString( DevHandle, pstr, 512) then
Result.ProductString := pStr;
If HidD_GetSerialNumberString( DevHandle, pstr, 512) then
Result.SerialNumberString := pStr;
{ Set Input buffer size }
HidD_SetNumInputBuffers( DevHandle,
HIDUSB_COUNTOFINTERRUPTBUFFERS);
{ Get capabilities }
HidD_GetPreparsedData( DevHandle, preparsedData);
if (preparsedData) then
begin
HidP_GetCaps( preparsedData, hidCaps);
Result.BufferSize := hidCaps.OutputReportByteLength;
end
else
Result.BufferSize := 11;
closeHandle( DevHandle);
end;
FreeMem( pStr);
End;
Begin
FoundIdx := 0;
DeviceList := Nil;
{ Get GUID of hid class }
HidD_GetHidGuid( HID_GUIid);
{ Get a list of devices belonging to HID class }
HIDinfo := SetupDiGetClassDevs( @HID_GUIid,
nil,
GetDesktopWindow(),
DIGCF_DEVICEINTERFACE or DIGCF_PRESENT);
{ Go through list of devices }
If thandle(HIDinfo) <> INVALID_HANDLE_VALUE then
begin
CurIdx := 0;
spdid.cbSize := SizeOf(spdid);
While SetupDiEnumDeviceInterfaces( HIDinfo,
nil,
HID_GUIid,
curIdx,
spdid) do
begin
dwSize := 0;
{ Get device path for Createfile calls }
SetupDiGetDeviceInterfaceDetail( HIDinfo,
@spdid,
nil,
dwSize,
@dwSize,
nil);
If dwSize > 0 then
begin
GetMem(pSpDidd, dwSize);
pSpDidd^.cbSize := SizeOf( TSPDEVICEINTERFACEDETAILDATAA);
spddd.cbSize := SizeOf(spddd);
If SetupDiGetDeviceInterfaceDetail( HIDinfo,
@spdid,
pSpDidd,
dwSize,
@dwSize,
@spddd) then
begin
SymbolicLink := PChar( @(pSpDidd^.DevicePath));
{ Get information about the device (Vendor and
Product IDs, Strings, ...) }
FillChar(info, SizeOf(Info), 0);
Info := GetHidDeviceInfo( @(pSpDidd^.DevicePath));
Info.Handle := INVALID_HANDLE_VALUE;
{ check if VID/PID match targets }
If (Info.VID = TargetVID) AND
(Info.PID = TargetPID) then
begin
{ Add Devices to result list }
SetLength(DeviceList, FoundIdx + 1);
DeviceList[foundIdx] := Info;
Inc(FoundIdx);
end
else // list all HID devices if no target is specified
If (TargetVID = 0) AND (TargetPID = 0) then
begin
{ Add Devices to result list }
SetLength( DeviceList, FoundIdx + 1);
DeviceList[FoundIdx] := Info;
Inc(FoundIdx);
end;
end;
FreeMem( pSpDidd);
end;
inc(CurIdx);
end;
SetupDiDestroyDeviceInfoList( HIDinfo);
end;
End;
procedure TForm1.Button1Click(Sender: TObject);
Var
DeviceList : THIDDeviceList;
I : Integer;
begin
ScanForHIDdevices( DeviceList, 0, 0);
Memo1.Lines.Clear;
Memo1.Lines.Add(IntToStr(Length(DeviceList)) + ' device(s) found');
If Length(DeviceList) > 0 then
For I := 0 to Length(DeviceList)-1 do
With DeviceList[I] do
begin
Memo1.Lines.Add('Device Number : ' + IntToStr(I));
Memo1.Lines.Add('Symbolic link : ' + SymLink);
Memo1.Lines.Add('Handle : 0x' + IntToHex(Handle, 1));
Memo1.Lines.Add('Buffer size : ' + IntToStr(BufferSize));
Memo1.Lines.Add('VID : 0x' + IntToHex(VID, 4));
Memo1.Lines.Add('PID : 0x' + IntToHex(PID, 4));
Memo1.Lines.Add('Version : ' + IntToStr(VersionNumber));
Memo1.Lines.Add('Manufacturer : ' + ManufacturerString);
Memo1.Lines.Add('Product name : ' + ProductString);
Memo1.Lines.Add('Serial number : ' + SerialNumberString);
Memo1.Lines.Add(' ');
end;
Memo1.SetFocus;
end;
string
variables, while prior versions use ANSI strings. However, with no info about what the problem is, I can't really say. :) – Ken WhiteGetHidDeviceInfo
to get info about a USB drive? What the parameter should look like? The drive letter? – Delphi.Boy