unit main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees.BaseAncestorVCL, VirtualTrees.BaseTree, VirtualTrees.AncestorVCL, VirtualTrees, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls; const GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{CDDE880F-898A-4DAB-B0EA-51FBA32C1D82}'; DBT_DEVICEARRIVAL = $8000; // system detected a new device DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class type PDevBroadcastHdr = ^DEV_BROADCAST_HDR; DEV_BROADCAST_HDR = packed record dbch_size : DWORD; dbch_devicetype: DWORD; dbch_reserved : DWORD; end; PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE; DEV_BROADCAST_DEVICEINTERFACE = record dbcc_size : DWORD; dbcc_devicetype: DWORD; dbcc_reserved : DWORD; dbcc_classguid : TGUID; dbcc_name : char; end; TfrmMain = class(TForm) tvItems : TVirtualStringTree; pcFunctions : TPageControl; tsFirmware : TTabSheet; tsIIC : TTabSheet; od : TOpenDialog; Button1 : TButton; StaticText1 : TStaticText; ebFirmware : TEdit; btnDownload : TButton; Button2: TButton; Button3: TButton; Button4: TButton; procedure FormCreate( Sender : TObject); procedure FormDestroy( Sender : TObject); procedure FormShow( Sender : TObject); procedure tvItemsGetText( Sender : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex; TextType : TVSTTextType; var CellText : string); procedure tvItemsFreeNode( Sender : TBaseVirtualTree; Node : PVirtualNode); procedure Button1Click(Sender: TObject); procedure btnDownloadClick(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private procedure DoUsbArrival( ADevicePath : string); procedure DoUsbRemoval( ADevicePath : string); procedure RefreshDeviceNode( Node: PVirtualNode); end; var frmMain: TfrmMain; implementation uses mr.drv.trinity, mr.dev.usb, mr.dev.manager, mr.trinity, mr.trinity.types, m.jtag.types; type TNodeType = ( ntTRI, ntJTG ); PxxData = ^TxxData; TxxData = record NodeType : TNodeType; Name : string; VID : string; PID : string; Functions : string; Serial : string; Description : string; Location : string; DevicePath : string; Capabilities: TCapabilities; end; {$R *.dfm} // ================================================================================================ // main :: Form Ceate // ================================================================================================ procedure TfrmMain.Button1Click(Sender: TObject); begin od.Filter := '*.hex'; od.DefaultExt := '.hex'; if od.Execute then ebFirmware.Text := od.FileName; end; procedure TfrmMain.Button2Click(Sender: TObject); begin for var node in tvItems.Nodes do RefreshDeviceNode( node) end; procedure TfrmMain.Button3Click(Sender: TObject); begin var node : PVirtualNode := tvItems.FocusedNode; var data : PxxData := tvItems.GetNodeData( node); if (data <> nil) and (data.DevicePath <> '') then begin var dev := AllocateDevice( data.DevicePath); if dev is TTrinity then begin with TTrinity(dev) do begin var ids: array [0..9] of cardinal; var s := ''; for var i:=0 to 9 do ids[i] := 0; var buf: array [0..19] of AnsiChar; Open; buf[ 0] := 'R'; buf[ 1] := '?'; iic.Write( $41, 2, @buf[0], 100); iic.Read( $41, 11, @buf[0], 100); { buf[ 0] := 'C'; buf[ 1] := 'W'; iic.Write( $41, 2, @buf[0], 100); buf[ 0] := 'D'; buf[ 1] := '1'; buf[ 2] := '0'; buf[ 3] := '0'; buf[ 4] := '2'; buf[ 5] := '.'; buf[ 6] := '1'; buf[ 7] := '2'; buf[ 8] := '3'; buf[ 9] := '4'; buf[10] := '5'; iic.Write( $41, 11, @buf[0], 100); buf[ 0] := 'D'; buf[ 1] := '1'; buf[ 2] := '?'; iic.Write( $41, 3, @buf[0], 100); iic.Read( $41, 11, @buf[0], 100); } { jtag.scan( @ids[0], 10); for var i := 0 to 9 do begin if ids[i] <> 0 then begin if s <> '' then s := s+ ', '; s := s + Format( '%8.8X', [ids[i]]); end else break end; } Close end; end; DeallocateDevice( dev); end; end; procedure TfrmMain.Button4Click(Sender: TObject); begin var node : PVirtualNode := tvItems.FocusedNode; var data : PxxData := tvItems.GetNodeData( node); var buf : array [0..19] of AnsiChar; if (data <> nil) and (data.DevicePath <> '') then begin var dev := AllocateDevice( data.DevicePath); if dev is TTrinity then begin with TTrinity(dev) do begin var ids: array [0..9] of cardinal; var s := ''; for var i:=0 to 9 do ids[i] := 0; Open; iic.Read( $41, 12, @buf[0], 100); s := buf; Close end; end; DeallocateDevice( dev); end; end; procedure TfrmMain.btnDownloadClick(Sender: TObject); begin if FileExists( ebFirmware.Text) then begin var node : PVirtualNode := tvItems.FocusedNode; var data : PxxData := tvItems.GetNodeData( node); if (data <> nil) and (data.DevicePath <> '') then begin var dev := AllocateDevice( data.DevicePath); if dev is TTrinity then with TTrinity(dev) do begin Screen.Cursor := crHourGlass; Open; DownloadFirmware( ebFirmware.Text); Close; Screen.Cursor := crDefault; end; DeallocateDevice( dev); // RefreshDeviceNode( tvItems.FocusedNode); // tvItems.Invalidate; // tvItems.Refresh end; end; end; procedure TfrmMain.FormCreate(Sender: TObject); begin tvItems.NodeDataSize := sizeof( TxxData); RegisterUsbConnectEventHandler( DoUsbArrival); RegisterUsbDisconnectEventHandler( DoUsbRemoval); end; // ================================================================================================ // main :: form destroy // ================================================================================================ procedure TfrmMain.FormDestroy(Sender: TObject); begin RegisterUsbConnectEventHandler( nil); RegisterUsbDisconnectEventHandler( nil); end; // ================================================================================================ // main :: form show // ================================================================================================ procedure TfrmMain.FormShow(Sender: TObject); var Functions: TCapabilities; begin GetDeviceList ( function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean begin { var key := (VID shl 16) + PID; var s := ''; var f := ''; var sn := ''; var cap : TCapabilities; if key = $16D00712 then begin var dev := AllocateDevice( DevicePath); if dev is TTrinity then with TTrinity(dev) do begin Open; cap := TTrinity(dev).Capabilities; if (Functions = []) or ( (cap * Functions) = Functions) then f := Caps2String( cap) else f := ''; sn := TTrinity(dev).SerialNumber; if f <> '' then Desc := ' ['+ f +']'; Close end; DeallocateDevice( dev); end; } var node : PVirtualNode := tvItems.AddChild(nil); var data : PxxData := tvItems.GetNodeData( node); data.DevicePath := DevicePath; RefreshDeviceNode( node); exit; { if data <> nil then begin if key = $16D00712 then data.Name := 'Trinity' else data.Name := 'Cypress FX2LP'; data.VID := Format( '0x%4.4X', [VID]); data.PID := Format( '0x%4.4X', [PID]); data.Functions := f; data.Serial := sn; data.Description := Desc; data.Location := loc; data.DevicePath := DevicePath; data.Capabilities := cap; end; } { if capJTAG in cap then begin var dev2 := AllocateDevice( DevicePath); if dev2 is TTrinity then with TTrinity(dev2) do begin Open; var ids: array [0..9] of cardinal; var jtg: IJTAG; if Supports( dev2, IJTAG, jtg) then begin jtg.scan( @ids[0], 10); s := ''; for var i := 0 to 9 do begin if ids[i] <> 0 then begin if s <> '' then s := s+ ', '; s := s + Format( '%8.8X', [ids[i]]); node := tvItems.AddChild(node); data := tvItems.getnodedata( node); data.Name := s; end else break end; end; end; Close end; } exit( true) end ) end; // ================================================================================================ // tvItems :: Free Node // ================================================================================================ procedure TfrmMain.tvItemsFreeNode( Sender: TBaseVirtualTree; Node : PVirtualNode); begin var data: PxxData := Sender.GetNodeData( Node); if data <> nil then begin data.Name := ''; data.VID := ''; data.PID := ''; data.Functions := ''; data.Serial := ''; data.Description := ''; data.Location := ''; data.DevicePath := ''; end; end; // ================================================================================================ // tvItems :: Get Text // ================================================================================================ procedure TfrmMain.tvItemsGetText( Sender : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex; TextType : TVSTTextType; var CellText : string); begin var data: PxxData := Sender.GetNodeData( Node); if data <> nil then begin case Column of 0: CellText := data.Name; 1: CellText := data.VID; 2: CellText := data.PID; 3: CellText := data.Functions; 4: CellText := data.Serial; 5: CellText := data.Description; 6: CellText := data.Location; end end end; procedure TfrmMain.RefreshDeviceNode( Node: PVirtualNode); begin var data: PxxData:= tvItems.GetNodeData( node); if (data <> nil) and (data.DevicePath <> '') then begin var dev := AllocateDevice( data.DevicePath); if dev <> nil then begin var _fun := ''; var _sn := ''; var _dsc := dev.Description; var _key := (dev.VendorID shl 16) + dev.ProductID; if dev is TTrinity then with TTrinity(dev) do begin Open; var fun : TCapabilities := []; var cap := TTrinity(dev).Capabilities; if (fun = []) or ( (cap * fun) = fun) then _fun := Caps2String( cap); _sn := TTrinity(dev).SerialNumber; if _fun <> '' then _dsc := _dsc +' ['+ _fun +']'; Close end; if _key = $16D00712 then data.Name := 'Trinity' else data.Name := 'Cypress FX2LP'; data.VID := Format( '0x%4.4X', [ dev.VendorID ]); data.PID := Format( '0x%4.4X', [ dev.ProductID]); data.Location := dev.Location; data.Functions := _fun; data.Serial := _sn; data.Description := _dsc; end; tvItems.InvalidateNode( Node); DeallocateDevice( dev); end; end; procedure TfrmMain.DoUsbArrival( ADevicePath: string); begin var node: PVirtualNode := tvItems.AddChild(nil); var data: PxxData := tvItems.GetNodeData( node); data.DevicePath := ADevicePath; RefreshDeviceNode( node) end; procedure TfrmMain.DoUsbRemoval( ADevicePath: string); var vid : word; pid : word; loc : string; dsc : string; data: PxxData; next: PVirtualNode; begin ParseDevicePath( ADevicePath, vid, pid, loc, dsc); next := nil; with tvItems do begin BeginUpdate; for var node in LevelNodes( 0) do begin data := GetNodeData( node); if CompareText( data.Location, loc) = 0 then begin DeleteNode( node); break end; end; EndUpdate end end; end.