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

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;
    Info: TDriveInfo;
  end;

  TDlgUsbInfo = class(TForm)
    vtList: TVirtualStringTree;
    popFun: TPopupMenu;
    miRefresh: TMenuItem;
    N2: TMenuItem;
    miCopyAll: TMenuItem;
    miCopySerial: 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 miCopySerialClick(Sender: TObject);
    procedure popFunPopup(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  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.miCopySerialClick(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.popFunPopup(Sender: TObject);
var
  pNode: PVirtualNode;
begin
  pNode := vtList.GetFirstSelected;
  miCopyAll.Visible := pNode <> nil;
  miCopySerial.Visible := pNode <> nil;
end;

procedure TDlgUsbInfo.RefreshList;
var
  pData: PUsbInfo;
  dwLogicalDrv: DWORD;
  i: Integer;
  sDrive: String;
  DriveInfo: TDriveInfo;
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;
            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.sFsType;
    7 : CellText := IntToStr(pData.Info.nDiskNum);
    8 : CellText := pData.Info.sClass;
    9 : CellText := pData.Info.sClassGuid;
    10 : 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.