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.