--------------
请先下载HID控件
------DelphiXE测试可行------
本程序的DBgrid显示无用处，因为没有对其做什么处理，本例子仅作为监听USB参考
----------Unit---开始--------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, ExtCtrls, DBGridEhGrouping, Grids, RzGrids,
StdCtrls, JvComponentBase, JvHidControllerClass, Buttons, DBTables,
Menus, PropFilerEh, PropStorageEh, DBGrids;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel3: TPanel;
Panel4: TPanel;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
ADOCommand1: TADOCommand;
Memo1: TMemo;
Splitter1: TSplitter;
DataSource1: TDataSource;
Splitter2: TSplitter;
Splitter3: TSplitter;
ADOQuery1Test_DateTime: TDateTimeField;
ADOQuery1Test_Command: TStringField;
HidCtrl_01: TJvHidDeviceController;
PopupMenu1: TPopupMenu;
N0001: TMenuItem;
Edit3: TEdit;
DevListBox: TListBox;
DBGrid1: TDBGrid;
function HidCtrl_01Enumerate(HidDev: TJvHidDevice;
const Idx: Integer): Boolean;
procedure HidCtrl_01DeviceChange(Sender: TObject);
procedure HidCtrl_01DeviceData(HidDev: TJvHidDevice; ReportID: Byte;
const Data: Pointer; Size: Word);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
//procedure DBGridEh1CellClick(Column: TColumnEh);
procedure ADOQuery1AfterScroll(DataSet: TDataSet);
procedure N0001Click(Sender: TObject);
procedure HidCtrl_01Arrival(HidDev: TJvHidDevice);
procedure DevListBoxClick(Sender: TObject);
private
{ Private declarations }
public
CurrentDevice: TJvHidDevice;
CurrFiledvalue:string;
{ Public declarations }
end;
TMyWriteDataToDataBase=class(TThread)
private
FMyStringList:TStringList;
procedure SetStringList(vstrList:TStringList );
protected
procedure Execute; override ;
public
constructor Create; overload;
constructor Create(CreateSuspended: Boolean); overload;
property MyStringList:TStringList read FMyStringList write SetStringList;
end;
var
Form1: TForm1;
MyWriteDataToDataBase:TMyWriteDataToDataBase;
implementation
{$R *.dfm}
//延迟函数：方法一
{procedure delay(msecs:integer);
var
Tick: DWord;
Event: THandle;
begin
Event := CreateEvent(nil, False, False, nil);
try
Tick := GetTickCount + DWord(msecs);
while (msecs > 0) and (MsgWaitForMultipleObjects(1, Event, False, msecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do
begin
Application.ProcessMessages;
msecs := Tick - GetTickcount;
end;
finally
CloseHandle(Event);
end;
end; }
{用Delay代替Sleep}
procedure Delay(dwMilliseconds:DWORD);stdcall;//Longint
var
iStart,iStop:DWORD;
begin
iStart := GetTickCount;
repeat
iStop := GetTickCount;
Application.ProcessMessages;
until (iStop - iStart) >= dwMilliseconds;
end;
procedure AddDatato(v:Tstringlist); stdcall;
begin
if v.Count >0 then // Form1.ListBox1.items.Count >0
begin
//Form1.ADOCommand1.commandtext:=Format('insert into CommandParser(Test_DateTime,Test_Command) Values (%f,''%s'')',[SysUtils.now(),Form1.ListBox1.items.Strings[0]]);
{Form1.Edit2.Text :=FormatDateTime('yyyymmdd hh:mm:ss zzz',now);
Form1.ADOCommand1.commandtext:=Format('insert into CommandParser(Test_DateTime,Test_Command) Values (%.6f,''%s'')',[now,Form1.ListBox1.items.Strings[0]]);
Form1.ADOCommand1.Execute ;
Form1.ListBox1.items.Delete(0); }
//Form1.Edit2.Text :=FormatDateTime('yyyymmdd hh:mm:ss zzz',now);
///Form1.ADOCommand1.commandtext:=Format('insert into CommandParser(Test_DateTime,Test_Command) Values (%.10f,''%s'')',[now,v.Strings[0]]); //用这个，数据库中的日期会多两天
Form1.ADOCommand1.commandtext:=Format('insert into CommandParser(Test_DateTime,Test_Command) Values (''%s'',''%s'')',[FormatDateTime('yyyy/mm/dd hh:mm:ss.zzz',now),v.Strings[0]]);
Form1.ADOCommand1.Execute ;
v.Delete(0);
end;
end;
procedure TForm1.ADOQuery1AfterScroll(DataSet: TDataSet);
begin
Memo1.Lines.Text :=ADOQuery1.FieldByName ('Test_Command').AsString ;
end;
{procedure TForm1.DBGridEh1CellClick(Column: TColumnEh);
var
p:Tpoint;
begin
CurrFiledvalue:=Column.Field.AsString ;
GetCursorPos(p);
PopupMenu1.Popup(p.X,p.y) ;
end; }
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyWriteDataToDataBase.Suspend;
end;
procedure TForm1.FormShow(Sender: TObject);
//var
//v:TStringList ;
begin
MyWriteDataToDataBase:=TMyWriteDataToDataBase.Create(True );
// v:= TStringList.Create ;
//MyWriteDataToDataBase.MyStringList :=v;
end;
procedure TForm1.HidCtrl_01Arrival(HidDev: TJvHidDevice);
begin
//ShowMessage(HidDev.ProductName);
end;
procedure TForm1.HidCtrl_01DeviceChange(Sender: TObject);
var
Dev: TJvHidDevice;
I: Integer;
begin
DevListBox.Items.Clear;
HidCtrl_01.Enumerate;
if Assigned(DevListBox) then
begin
for I := 0 to DevListBox.Items.Count - 1 do
begin
Dev := TJvHidDevice(DevListBox.Items.Objects[I]);
Dev.Free;
end;
DevListBox.Clear;
//HistoryListBox.Clear;
HidCtrl_01.Enumerate;
if DevListBox.Items.Count > 0 then
begin
DevListBox.ItemIndex := 0;
DevListBoxclick (Self);
end;
end;
end;
procedure TForm1.HidCtrl_01DeviceData(HidDev: TJvHidDevice; ReportID: Byte;
const Data: Pointer; Size: Word);
var
I: Integer;
Str: string;
begin
Str := Format('R %.2x :', [ReportID]);
for I := 0 to Size - 1 do
Str := Str + Format('%.2x ', [Cardinal(PAnsiChar(Data)[I])]);
MyWriteDataToDataBase.MyStringList.Add(Str) ; //MyWriteDataToDataBase.MyStringList.Add(Str) ;
//ListBox1.ItemIndex := ListBox1.Items.Add(Str);
end;
function TForm1.HidCtrl_01Enumerate(HidDev: TJvHidDevice;
const Idx: Integer): Boolean;
var
N: Integer;
Dev: TJvHidDevice;
begin
if Assigned(DevListBox) then
begin
if HidDev.ProductName <> '' then
N := DevListBox.Items.Add(HidDev.ProductName)
else
N := DevListBox.Items.Add(Format('Device VID=%.4x PID=%.4x',
[HidDev.Attributes.VendorID, HidDev.Attributes.ProductID]));
HidCtrl_01.CheckOutByIndex(Dev, Idx);
DevListBox.Items.Objects[N] := Dev;
end;
//Timer1.Enabled :=True;
if MyWriteDataToDataBase.Suspended then
MyWriteDataToDataBase.Resume;
Result := True;
end;
procedure TForm1.DevListBoxClick(Sender: TObject);
var
I: Integer;
Dev: TJvHidDevice;
begin
//SpeedButton1.Down := False;
//SpeedButton1Click(Self);
end;
procedure TForm1.N0001Click(Sender: TObject);
begin
ShowMessage(CurrFiledvalue);
end;
{ TMyWriteDataToDataBase }
constructor TMyWriteDataToDataBase.Create;
var
v:TStringList ;
begin
inherited ;
v:= TStringList.Create ;
FMyStringList :=v;
end;
constructor TMyWriteDataToDataBase.Create(CreateSuspended: Boolean);
var
v:TStringList ;
begin
inherited ;
v:= TStringList.Create ;
FMyStringList :=v;
end;
procedure TMyWriteDataToDataBase.Execute;
begin
while Terminated=false do
begin
AddDatato(MyStringList ) ;
Delay(10);//延时10毫秒
end;
end;
procedure TMyWriteDataToDataBase.SetStringList(vstrList: TStringList);
begin
FMyStringList:=vstrList;
end;
end.
{//延迟函数：方法一
procedure delay(msecs:integer);
var
Tick: DWord;
Event: THandle;
begin
Event := CreateEvent(nil, False, False, nil);
try
Tick := GetTickCount + DWord(msecs);
while (msecs > 0) and (MsgWaitForMultipleObjects(1, Event, False, msecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do
begin
Application.ProcessMessages;
msecs := Tick - GetTickcount;
end;
finally
CloseHandle(Event);
end;
//延迟函数：方法二
procedure Delay(dwMilliseconds:DWORD);//Longint
var
iStart,iStop:DWORD;
begin
iStart := GetTickCount;
repeat
iStop := GetTickCount;
Application.ProcessMessages;
until (iStop - iStart) >= dwMilliseconds;
End;}
------------------------Unit-结束----------
-----------Form开始--
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 496
ClientWidth = 1046
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 1046
Height = 496
Align = alClient
Caption = 'Panel1'
TabOrder = 0
object Splitter2: TSplitter
Left = 1
Top = 1
Height = 494
ExplicitLeft = 360
ExplicitTop = 144
ExplicitHeight = 100
end
object Splitter3: TSplitter
Left = 209
Top = 1
Height = 494
ExplicitLeft = 656
ExplicitTop = 120
ExplicitHeight = 100
end
object Panel3: TPanel
Left = 4
Top = 1
Width = 205
Height = 494
Align = alLeft
Caption = 'Panel3'
TabOrder = 0
object Edit3: TEdit
Left = 48
Top = 456
Width = 121
Height = 21
ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
TabOrder = 0
Text = 'Edit3'
end
object DevListBox: TListBox
Left = 6
Top = 1
Width = 171
Height = 56
ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
ItemHeight = 13
TabOrder = 1
OnClick = DevListBoxClick
end
end
object Panel4: TPanel
Left = 212
Top = 1
Width = 833
Height = 494
Align = alClient
Caption = 'Panel4'
TabOrder = 1
object Splitter1: TSplitter
Left = 1
Top = 373
Width = 831
Height = 3
Cursor = crVSplit
Align = alBottom
ExplicitTop = 1
ExplicitWidth = 375
end
object Memo1: TMemo
Left = 1
Top = 376
Width = 831
Height = 117
Align = alBottom
ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object DBGrid1: TDBGrid
Left = 1
Top = 1
Width = 831
Height = 372
Align = alClient
DataSource = DataSource1
ImeName = #20013#25991'('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
end
end
object ADOConnection1: TADOConnection
Connected = True
ConnectionString =
'Provider=SQLOLEDB.1;Password=sa123456;Persist Security Info=True' +
';User ID=sa;Initial Catalog=HJP;Data Source=.SQLEXPRESS'
LoginPrompt = False
Provider = 'SQLOLEDB.1'
Left = 504
Top = 64
end
object ADOQuery1: TADOQuery
Connection = ADOConnection1
CursorType = ctStatic
AfterScroll = ADOQuery1AfterScroll
EnableBCD = False
Parameters = <>
SQL.Strings = (
'select * from CommandParser')
Left = 832
Top = 112
object ADOQuery1Test_DateTime: TDateTimeField
DisplayLabel = #27979#35797#26102#38388
DisplayWidth = 22
FieldName = 'Test_DateTime'
DisplayFormat = 'yyyy-mm-dd hh:mm:ss zzz'
end
object ADOQuery1Test_Command: TStringField
DisplayLabel = #27979#35797#25351#20196
DisplayWidth = 66
FieldName = 'Test_Command'
Size = 500
end
end
object ADOCommand1: TADOCommand
Connection = ADOConnection1
Parameters = <>
Left = 504
Top = 120
end
object DataSource1: TDataSource
AutoEdit = False
DataSet = ADOQuery1
Left = 832
Top = 184
end
object HidCtrl_01: TJvHidDeviceController
DevThreadSleepTime = 10000
OnArrival = HidCtrl_01Arrival
OnEnumerate = HidCtrl_01Enumerate
OnDeviceChange = HidCtrl_01DeviceChange
OnDeviceData = HidCtrl_01DeviceData
Left = 80
Top = 16
end
object PopupMenu1: TPopupMenu
Left = 608
Top = 208
object N0001: TMenuItem
Caption = '000'
OnClick = N0001Click
end
end
end
-----------Form结束-------