Работа c USB HID в dll-библиотеке

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvHidControllerClass.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2004/09/06 04:59:45 $';
    LogPath: 'JVCL\run'
  );
 
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);
 
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

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

if not Device.WriteFile(Buf, ToWrite, Written) then
    begin
      Err := GetLastError;
      result := false;
    end
    else Result := True;

Device.OnData := OnData;

procedure TJvHidDevice.SetDataEvent(const DataEvent: TJvHidDataEvent);
begin
  // this assignment is a bit tricky because a thread may be running
  // kill the thread with the old event still in effect
  if not Assigned(DataEvent) then
    StopThread;
  // assign the new event and start the thread if needed
  FData := DataEvent;
  StartThread;
end;
procedure TJvHidDevice.StartThread;
begin
  if Assigned(FData) and IsPluggedIn and IsCheckedOut and
    HasReadWriteAccess and not Assigned(FDataThread) then
  begin
    FDataThread := TJvHidDeviceReadThread.CtlCreate(Self);
    FDataThread.FreeOnTerminate := False;
    FDataThread.Resume;
  end;
end;

  TJvHidDeviceReadThread = class(TThread)

procedure TJvHidDeviceReadThread.Execute;
var
  SleepRet: DWORD;
 
  procedure Dummy(ErrorCode: DWORD; Count: DWORD; Ovl: POverlapped); stdcall;
  begin
  end;
 
begin
  SleepRet := WAIT_IO_COMPLETION;
  while not Terminated do
  begin
    // read data
    SleepRet := WAIT_IO_COMPLETION;
    FillChar(Report[0], Device.Caps.InputReportByteLength, #0);
    if Device.ReadFileEx(Report[0], Device.Caps.InputReportByteLength, @Dummy) then
    begin
      // wait for read to complete
      repeat
        SleepRet := SleepEx(Device.ThreadSleepTime, True);
      until Terminated or (SleepRet = WAIT_IO_COMPLETION);
      // show data read
      if not Terminated then
      begin
        NumBytesRead := Device.HidOverlappedReadResult;
        if NumBytesRead > 0 then
          Synchronize(DoData);
      end;
    end
    else
    begin
      FErr := GetLastError;
      Synchronize(DoDataError);
    end;
  end;
  // cancel ReadFileEx call or the callback will
  // crash your program
  if SleepRet <> WAIT_IO_COMPLETION then
    Device.CancelIO(omhRead);
end;

unit MainDLLFormU;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, StrUtils, JvComponentBase, JvHidControllerClass,
  Vcl.StdCtrls, Vcl.ExtCtrls;
 
type
  TReportData = array[0..63] of Byte;    // Размер буфера 0-го репорта HID
  TDLLWorkForm = class(TForm)
    HIDCtl: TJvHidDeviceController;
    Timer1: TTimer;
    Label1: TLabel;
    ContinueStatus: TPanel;
    procedure HIDCtlArrival(HidDev: TJvHidDevice);
    procedure HIDCtlDeviceData(HidDev: TJvHidDevice; ReportID: Byte; const Data: Pointer; Size: Word);
    function HIDCtlEnumerate(HidDev: TJvHidDevice; const Idx: Integer): Boolean;
    procedure HIDCtlRemoval(HidDev: TJvHidDevice);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure SetCanContinue(Value:Boolean);
  public
    { Public declarations }
  end;
 
const
  ContinueOk = clLime;
  ContinueNotOk = clRed;
 
var
  DLLWorkForm: TDLLWorkForm;
  WorkDev: TJvHidDevice = nil;
  Written: Cardinal;
  ReportData: TReportData;
 
  ProductName:string;
  VendorID:WORD;
  ProductID:WORD;
  UseDeviceNameInFind:Boolean = False;
  CanContinueWork:Boolean = False;
  // Данные возвращаемые из DLL:
  Status:integer = -1;
  DLLValue:Cardinal;
 
function DLLWorkFormCreate(AppHandle:THandle; var DataStatus:integer):Cardinal; stdcall; export;
 
implementation
 
{$R *.dfm}
 
procedure TDLLWorkForm.SetCanContinue(Value: Boolean);
begin
  if Value then
  begin
    CanContinueWork:=True;
    ContinueStatus.Color:=ContinueOk;
  end else begin
    CanContinueWork:=False;
    ContinueStatus.Color:=ContinueNotOk;
    DLLWorkForm.Close;
  end;
end;
 
function HexToInt(const Value:string):Cardinal;
var a:integer;
    preresult:integer;
    mnojitel:integer;
    RevValue:string;
begin
  preresult:=0;
  RevValue:=ReverseString(Value);
  for a := 1 to Length(Value) do
  begin
    case a of
    1: mnojitel:=1;
    2: mnojitel:=16;
    3: mnojitel:=256;
    4: mnojitel:=4096;
    5: mnojitel:=65536;
    else mnojitel:=1048576;
    end;
    if CharInSet(RevValue[a],['0'..'9']) then
      preresult:=preresult+StrToInt(RevValue[a])*mnojitel
    else begin
           if RevValue[a] = 'A' then preresult:=preresult+10*mnojitel
           else if RevValue[a] = 'B' then preresult:=preresult+11*mnojitel
           else if RevValue[a] = 'C' then preresult:=preresult+12*mnojitel
           else if RevValue[a] = 'D' then preresult:=preresult+13*mnojitel
           else if RevValue[a] = 'E' then preresult:=preresult+14*mnojitel
           else preresult:=preresult+15*mnojitel;
         end;
  end;
  Result:=preresult;
end;
 
function WorkDevSetFeature(Buf: TReportData):Boolean;
begin
  // Передача данных в устройство (получение данных с устройства обрабатывается процедурой: .HIDCtlDeviceData(HidDev: TJvHidDevice; ReportID: Byte; const Data: Pointer; Size: Word);)
  if Assigned(WorkDev) then
  begin
    Result:=WorkDev.WriteFile(Buf, WorkDev.Caps.OutputReportByteLength, Written);
  end else Result:= False;
end;
 
procedure SetQueryAboutKeyNumber;
begin
  //Application.ProcessMessages;
  FillChar(ReportData, SizeOf(ReportData), 0);  // Заполнение массива нулями
  ReportData[0] := 0;   // Номер репорта
  ReportData[1] := $82; // Суть запроса
  if not (WorkDevSetFeature(ReportData)) then
  begin
    DLLWorkForm.Timer1.Enabled:=False;
    Application.MessageBox('Не удалось отправить запрос в устройство!','Запрос не отправлен',mb_ok+mb_iconerror);
    DLLWorkForm.SetCanContinue(False);
  end;
end;
 
procedure TDLLWorkForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;
 
procedure TDLLWorkForm.FormShow(Sender: TObject);
begin
  // "Забыть" все предыдущие данные
  FillChar(ReportData, SizeOf(ReportData), 0);
  ReportData[0] := 0;   // Номер репорта
  ReportData[1] := $81; // Суть запроса
  if not (WorkDevSetFeature(ReportData)) then
  begin
    DLLWorkForm.Timer1.Enabled:=False;
    Application.MessageBox('Данные не занулены. Возможна коллизия в следующем ответе!','Запрос не отправлен',mb_ok+mb_iconerror);
    DLLWorkForm.SetCanContinue(False);
  end
end;
 
procedure TDLLWorkForm.HIDCtlArrival(HidDev: TJvHidDevice);
begin
  if not Assigned(WorkDev) then HidCtl.Enumerate;
end;
 
procedure TDLLWorkForm.HIDCtlDeviceData(HidDev: TJvHidDevice; ReportID: Byte; const Data: Pointer; Size: Word);
var pWORD: ^Word;
    a:Cardinal;
    c:Cardinal;
    AsciiReport:string;
    AnswerReportData: TReportData;
    ReturnedID:string;
begin
  Timer1.Enabled:=False;
  Status:=-1;
  pWORD:=Data;
  // Просмотр памяти через укахатели:
  c:=0;
  for a := 1 to (Size div 2) do
  begin
    AnswerReportData[c]:=((pWORD^) shr 0) and $FF;
    AnswerReportData[c+1]:=((pWORD^) shr 8) and $FF;
    c:=c+2;
    Inc(pWORD);
  end;
 
  // Проверка получения целостности пакета по USB:
  c:=AnswerReportData[0];
  for a := 1 to (High(AnswerReportData)-1) do
  begin
    c:=c xor AnswerReportData[a];
  end;
  if c = AnswerReportData[High(AnswerReportData)] then
  begin
    // По USB без повреждений, проверка самой посылки:
    AsciiReport:='';
    ReturnedID:='';
    c:=0;
    for a := 1 to 12 do
    begin
      AsciiReport:=asciireport+chr(AnswerReportData[a]);
      if (a mod 2) = 0 then
      begin
        if a < 11 then
        begin
          // Обычное значение
          c:=c xor HexToInt(Copy(asciireport,a-1,2));
        end else begin
          // Контрольное значение
          if c = HexToInt(Copy(asciireport,a-1,2)) then
          begin
            // ID контроля корректный:
            ReturnedID:=Copy(AsciiReport,3,Length(AsciiReport)-4);
            Status:=0;
          end else begin
            // ID подправлен ручками или неверно считан:
            Status:=2;
          end;
        end;
      end;
    end;
  end else begin
    // Пакет пришёл "битый"
    //ShowMessage('USB: bad packet');
    Status:=1;
  end;
 
  // Определение возвращаемого номера:
  if Status = 0 then
  begin
    DLLValue:=HexToInt(ReturnedID);
    DLLWorkForm.Close;
  end else begin
    Timer1.Enabled:=True;
  end;
end;
 
function TDLLWorkForm.HIDCtlEnumerate(HidDev: TJvHidDevice; const Idx: Integer): Boolean;
begin
  Result := True;
  //if (Trim(HidDev.ProductName) = ProductName) then
  if (HidDev.Attributes.VendorID = VendorID) and (HidDev.Attributes.ProductID = ProductID) then
  begin
    Result:=False;
    HidCtl.CheckOutByIndex(WorkDev, Idx);
    DLLWorkForm.Caption := 'Status device: OK';
    DLLWorkForm.SetCanContinue(True);
  end;
end;
 
procedure TDLLWorkForm.HIDCtlRemoval(HidDev: TJvHidDevice);
begin
  if HidDev = WorkDev then
  begin
    WorkDev := nil;
    DLLWorkForm.Caption := 'Status device: ERROR';
    DLLWorkForm.SetCanContinue(False);
  end;
end;
 
procedure TDLLWorkForm.Timer1Timer(Sender: TObject);
begin
  if CanContinueWork then
    SetQueryAboutKeyNumber
  else
    DLLWorkForm.Close;
end;
 
procedure SetNewIDData(PID:WORD; VID:WORD; DeviceName:string; UseDeviceName:Boolean);
begin
  if (UseDeviceName) and (Trim(DeviceName) <> '') then
    UseDeviceNameInFind:=True
  else
    UseDeviceNameInFind:=False;
  VendorID:=VID;
  ProductID:=PID;
  ProductName:=DeviceName;
end;
 
function DLLWorkFormCreate(AppHandle:THandle; var DataStatus:integer):Cardinal; stdcall; export;
begin
  SetNewIDData($1256,$0342,'My HID USB Device',False);
  Status:=-1;
  DLLWorkForm:=nil;
  Result:=0;
  Application.Handle:=AppHandle;
  try
    DLLWorkForm:=TDLLWorkForm.Create(Application);
    Application.ProcessMessages;
    DLLWorkForm.ShowModal;
    DataStatus:=Status;
    Result:=DLLValue;
    DLLWorkForm.Free;
    DLLWorkForm:=nil;
    Application.ProcessMessages;
    Application.Handle:=0;
  except
    On E:exception do begin
      ShowMessage(E.Message);
      if Assigned(DLLWorkForm) then DLLWorkForm.Free;
    end;
  end;
end;
 
end.