Initial check in

This commit is contained in:
2026-01-08 19:21:09 +01:00
commit ed86847030
7 changed files with 1995 additions and 0 deletions
+26
View File
@@ -0,0 +1,26 @@
__history
__recovery
bin
dcu
*.exe
prj.dpgxcon\Win32
prj.dpgxcon\Win64
*.dcu
*.res
*.identcache
*.local
*.dsk
*.dsv
# documentation intermediate files (TeX)
*.aux
*.bmt
*.dvi
*.log
*.lot
*.mtc*
*.mlt*
*.toc
*.hex
Binary file not shown.
+14
View File
@@ -0,0 +1,14 @@
program tri;
uses
Vcl.Forms,
main in '..\..\src.tri\main.pas' {frmMain};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
File diff suppressed because it is too large Load Diff
+44
View File
@@ -0,0 +1,44 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{2C32184F-3FD9-47DB-96C8-F045004883A5}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="Delphi12Athens\tri.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="tri">
<MSBuild Projects="Delphi12Athens\tri.dproj"/>
</Target>
<Target Name="tri:Clean">
<MSBuild Projects="Delphi12Athens\tri.dproj" Targets="Clean"/>
</Target>
<Target Name="tri:Make">
<MSBuild Projects="Delphi12Athens\tri.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="tri"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="tri:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="tri:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
<ItemGroup Condition="'$(BuildGroup)'=='All'">
<BuildGroupProject Include="Delphi12Athens\tri.dproj">
<ProjectGuid>{29C9F1DF-C66E-4F8B-ACF7-63B878409C07}</ProjectGuid>
<Configurations>Debug</Configurations>
<Platforms>Win32</Platforms>
<Enabled>True</Enabled>
</BuildGroupProject>
</ItemGroup>
</Project>
+221
View File
@@ -0,0 +1,221 @@
object frmMain: TfrmMain
Left = 0
Top = 0
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Trinity bizgentyu'
ClientHeight = 994
ClientWidth = 1670
Color = clBtnFace
Constraints.MinHeight = 536
Constraints.MinWidth = 851
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Segoe UI'
Font.Style = []
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 192
DesignSize = (
1670
994)
TextHeight = 32
object tvItems: TVirtualStringTree
Left = 11
Top = 11
Width = 1648
Height = 294
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Anchors = [akLeft, akTop, akRight]
DefaultNodeHeight = 40
Header.AutoSizeIndex = 5
Header.Height = 38
Header.MaxHeight = 20000
Header.MinHeight = 20
Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible, hoAutoSpring]
Indent = 36
Margin = 8
TabOrder = 0
TextMargin = 8
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages, toFullVertGridLines, toUseExplorerTheme]
TreeOptions.SelectionOptions = [toFullRowSelect, toSelectNextNodeOnRemoval]
OnFreeNode = tvItemsFreeNode
OnGetText = tvItemsGetText
Touch.InteractiveGestures = [igPan, igPressAndTap]
Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough]
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coUseCaptionAlignment, coEditable, coStyleColor]
Position = 0
Spacing = 4
Text = 'Name'
Width = 200
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coUseCaptionAlignment, coEditable, coStyleColor]
Position = 1
Spacing = 4
Text = 'VID'
Width = 120
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coUseCaptionAlignment, coEditable, coStyleColor]
Position = 2
Spacing = 4
Text = 'PID'
Width = 120
end
item
Position = 3
Spacing = 4
Text = 'Functions'
Width = 400
end
item
Position = 4
Spacing = 4
Text = 'Serial'
Width = 150
end
item
Position = 5
Spacing = 4
Text = 'Description'
Width = 400
end
item
Position = 6
Spacing = 4
Text = 'Location'
Width = 200
end>
end
object pcFunctions: TPageControl
Left = 12
Top = 318
Width = 1646
Height = 664
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
ActivePage = tsFirmware
Anchors = [akLeft, akTop, akRight, akBottom]
TabOrder = 1
object tsFirmware: TTabSheet
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Firmware'
object Button1: TButton
Left = 1072
Top = 28
Width = 86
Height = 50
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = '...'
TabOrder = 0
OnClick = Button1Click
end
object StaticText1: TStaticText
Left = 32
Top = 38
Width = 120
Height = 36
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'StaticText1'
TabOrder = 1
end
object ebFirmware: TEdit
Left = 288
Top = 34
Width = 772
Height = 40
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
TabOrder = 2
end
object btnDownload: TButton
Left = 1184
Top = 28
Width = 150
Height = 50
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Download'
TabOrder = 3
OnClick = btnDownloadClick
end
object Button2: TButton
Left = 1056
Top = 272
Width = 150
Height = 50
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Refresh'
TabOrder = 4
OnClick = Button2Click
end
end
object tsIIC: TTabSheet
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'tsIIC'
ImageIndex = 1
end
end
object Button3: TButton
Left = 640
Top = 480
Width = 150
Height = 50
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Button3'
TabOrder = 2
OnClick = Button3Click
end
object Button4: TButton
Left = 640
Top = 592
Width = 150
Height = 50
Margins.Left = 6
Margins.Top = 6
Margins.Right = 6
Margins.Bottom = 6
Caption = 'Button4'
TabOrder = 3
OnClick = Button4Click
end
object od: TOpenDialog
Left = 1088
Top = 192
end
end
+570
View File
@@ -0,0 +1,570 @@
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.