BSOne.SFC/eCrmHE/EXE_eCrmHomeEdition/Info/DUsbInfo.pas

338 lines
9.4 KiB
Plaintext

unit DUsbInfo;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.Menus, Tocsg.Driver;
type
PUsbInfo = ^TUsbInfo;
TUsbInfo = record
sDrive,
sFsType,
sVolName: String;
sVid,
sPid,
sSerial : string;
Info: TDriveInfo;
end;
TDlgUsbInfo = class(TForm)
vtList: TVirtualStringTree;
popFun: TPopupMenu;
miRefresh: TMenuItem;
N2: TMenuItem;
miCopyAll: TMenuItem;
miInstanceId: TMenuItem;
miCopyVidPidSerial: TMenuItem;
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure miRefreshClick(Sender: TObject);
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure miCopyAllClick(Sender: TObject);
procedure miInstanceIdClick(Sender: TObject);
procedure popFunPopup(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure miVidPidSerialClick(Sender: TObject);
private
{ Private declarations }
procedure RefreshList;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
end;
var
DlgUsbInfo: TDlgUsbInfo;
implementation
uses
Tocsg.Files, Tocsg.Convert, VirtualTrees.Types, System.Math, Tocsg.VTUtil,
Tocsg.Exception, Tocsg.Disk, Tocsg.Safe, Vcl.Clipbrd;
resourcestring
RS_CopyCB = '클립보드에 복사 되었습니다.';
{$R *.dfm}
Constructor TDlgUsbInfo.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
RefreshList;
end;
procedure TDlgUsbInfo.CreateParams(var Params: TCreateParams);
begin
Inherited CreateParams(Params);
Params.ExStyle := WS_EX_APPWINDOW;
end;
procedure TDlgUsbInfo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := TCloseAction.caFree;
end;
procedure TDlgUsbInfo.miCopyAllClick(Sender: TObject);
begin
if VT_CopyToClipboardSelectedInfo(vtList) = 0 then
MessageBox(Handle, PChar(RS_CopyCB), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgUsbInfo.miInstanceIdClick(Sender: TObject);
var
pNode: PVirtualNode;
pData: PUsbInfo;
cbd: TClipboard;
begin
try
pNode := vtList.GetFirstSelected;
if pNode = nil then
exit;
pData := vtList.GetNodeData(pNode);
Guard(cbd, TClipboard.Create);
cbd.AsText := pData.Info.sSerial;
MessageBox(Handle, PChar(RS_CopyCB), PChar(Caption), MB_ICONINFORMATION or MB_OK);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. miCopySerialClick()');
end;
end;
procedure TDlgUsbInfo.miRefreshClick(Sender: TObject);
begin
RefreshList;
end;
procedure TDlgUsbInfo.miVidPidSerialClick(Sender: TObject);
var
pNode: PVirtualNode;
pData: PUsbInfo;
cbd: TClipboard;
begin
try
pNode := vtList.GetFirstSelected;
if pNode = nil then
exit;
pData := vtList.GetNodeData(pNode);
Guard(cbd, TClipboard.Create);
cbd.AsText := '0x' + pData.sVid + ', 0x' + pData.sPid + ', ' + pData.sSerial;
MessageBox(Handle, PChar(RS_CopyCB), PChar(Caption), MB_ICONINFORMATION or MB_OK);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. miCopySerialClick()');
end;
end;
procedure TDlgUsbInfo.popFunPopup(Sender: TObject);
var
pNode: PVirtualNode;
begin
pNode := vtList.GetFirstSelected;
miCopyAll.Visible := pNode <> nil;
miInstanceId.Visible := pNode <> nil;
end;
procedure TDlgUsbInfo.RefreshList;
var
pData: PUsbInfo;
dwLogicalDrv: DWORD;
i: Integer;
sDrive: String;
DriveInfo: TDriveInfo;
Parts, SubParts: TArray<string>;
sTemp: string;
begin
vtList.BeginUpdate;
try
VT_Clear(vtList);
try
dwLogicalDrv := GetLogicalDrives;
for i := 0 to 31 do
begin
if (dwLogicalDrv and (1 shl i)) > 0 then
begin
sDrive := Format('%s:\', [Char(Integer('A')+i)]);
if GetDriveType(PChar(sDrive)) <> DRIVE_CDROM then
begin
GetDriveDetail(sDrive, @DriveInfo);
if Pos('USB', UpperCase(DriveInfo.sSerial)) > 0 then
begin
pData := VT_AddChildData(vtList);
pData.sDrive := sDrive;
pData.sVolName := GetVolumeName(sDrive);
pData.sFsType := GetVolumeFilesystem(sDrive);
pData.Info := DriveInfo;
//파싱 시작
Parts := DriveInfo.sSerial.Split(['\']);
if Length(Parts) >= 3 then
begin
pData.sSerial := Parts[2];
if Pos('VID_', Parts[1]) > 0 then
begin
pData.sVID := '0x';
pData.sVID := pData.sVID + Copy(Parts[1], Pos('VID_', Parts[1]) + 4, 4);
end;
if Pos('PID_', Parts[1]) > 0 then
begin
pData.sPID := '0x';
pData.sPID := Copy(Parts[1], Pos('PID_', Parts[1]) + 4, 4);
end;
end;
//USBSTOR\DISK&VEN_VENDORCO&PROD_PRODUCTCODE&REV_2.00\8328501217610604362&0
Parts := DriveInfo.sInstanceId.Split(['\']);
if Length(Parts) >= 3 then
begin
sTemp := Parts[Length(Parts) - 1]; // "8328501217610604362&0"
if Pos('&', sTemp) > 0 then
pData.sSerial := pData.sSerial + '(' + Copy(sTemp, 1, Pos('&', sTemp) - 1) + ')'
else
pData.sSerial := pData.sSerial + '(' + sTemp + ')';
SubParts := Parts[1].Split(['&']);
for sTemp in SubParts do
begin
if Pos('VEN_', sTemp) = 1 then
pData.sVID := pData.sVID + '(' + Copy(sTemp, 5, MaxInt) + ')'
else if Pos('PROD_', sTemp) = 1 then
pData.sPID := pData.sPID + '(' + Copy(sTemp, 6, MaxInt) + ')';
end;
end;
end;
end;
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. RefreshList()');
end;
finally
vtList.EndUpdate;
end;
end;
procedure TDlgUsbInfo.vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
pData1, pData2: PUsbInfo;
begin
case Column of
4 :
begin
pData1 := Sender.GetNodeData(Node1);
pData2 := Sender.GetNodeData(Node2);
Result := CompareValue(pData1.Info.llSize, pData2.Info.llSize);
end;
else Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]);
end;
end;
procedure TDlgUsbInfo.vtListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PUsbInfo;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgUsbInfo.vtListGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtList.Text[Node, Column];
end;
procedure TDlgUsbInfo.vtListGetNodeDataSize(
Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TUsbInfo);
end;
procedure TDlgUsbInfo.vtListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PUsbInfo;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := pData.sDrive;
2 : CellText := pData.sVolName;
3 : CellText := pData.Info.sFriendlyName;
4 : CellText := ByteSizeToStr(pData.Info.llSize);
5 : CellText := pData.Info.sSerial;
6 : CellText := pData.sVid;
7 : CellText := pData.sPid;
8 : CellText := pData.sSerial;
9 : CellText := pData.sFsType;
10 : CellText := IntToStr(pData.Info.nDiskNum);
11 : CellText := pData.Info.sInstanceId;
12 : CellText := pData.Info.sClass;
13 : CellText := pData.Info.sClassGuid;
14 : CellText := pData.Info.sDesc;
end;
end;
procedure TDlgUsbInfo.vtListHeaderClick(Sender: TVTHeader;
HitInfo: TVTHeaderHitInfo);
begin
if HitInfo.Button = mbLeft then
begin
if HitInfo.Column < 0 then
exit;
with Sender, Treeview do
begin
if SortColumn > NoColumn then
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
begin
SortColumn := HitInfo.Column;
SortDirection := sdAscending;
end else
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending;
Columns[SortColumn].Color := $00EFEFEF;
vtList.BeginUpdate;
try
vtList.SortTree(SortColumn, SortDirection, False);
finally
vtList.EndUpdate;
end;
end;
end;
end;
end.