BSOne.SFC/Tocsg.Module/MSAAExtrator/DMsaaExtrMain.pas

unit DMsaaExtrMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.ExtCtrls, Vcl.StdCtrls,
  System.Generics.Collections;

type
  PAccEnt = ^TAccEnt;
  TAccEnt = record
    sName, sRole, sVal: String;
    nLevel: Integer;
  end;

  TDlgMsaaExtrMain = class(TForm)
    pnTop: TPanel;
    vtTree: TVirtualStringTree;
    edWH: TEdit;
    btnExtract: TButton;
    SP1: TSplitter;
    mmInfo: TMemo;
    Label1: TLabel;
    edLv: TEdit;
    Label2: TLabel;
    procedure btnExtractClick(Sender: TObject);
    procedure vtTreeGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure vtTreeGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
      var HintText: string);
    procedure vtTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DlgMsaaExtrMain: TDlgMsaaExtrMain;

implementation

uses
  Tocsg.MSAA, Tocsg.Strings, Winapi.ActiveX, Tocsg.VTUtil,
  Tocsg.Safe, Tocsg.WndUtil, Winapi.oleacc;

{$R *.dfm}

procedure TDlgMsaaExtrMain.btnExtractClick(Sender: TObject);
var
  h: HWND;
  ProcEnumAccessible: TProcessEnumAccessible;
  arrRoleStr: array [0..300] of Char;
  DcNode: TDictionary<IAccessible,PVirtualNode>;
  sText: String;
  nLv: Integer;
begin
  edWH.Text := Trim(edWH.Text);
  edLv.Text := Trim(edLv.Text);
  nLv := StrToIntDef(edLv.Text, 0);
  h := FindWindowFromProcessName(edWH.Text);

  if h = 0 then
  begin
    MessageBox(Handle, PChar('프로그램을 찾을 수 없습니다.'), PChar(Caption), MB_ICONWARNING or MB_OK);
    exit;
  end;

  sText := '';
  Guard(DcNode, TDictionary<IAccessible,PVirtualNode>.Create);

  ProcEnumAccessible :=
    procedure(aParentAccObj, aAccObj: IAccessible; varChild: OleVariant; h: HWND; nLevel: Integer; var bContinue: Boolean)
    var
      sName,
      sRole: String;
      pPNode, pNode: PVirtualNode;
      pData: PAccEnt;
    begin
      bContinue := true;
      try
        if Assigned(aAccObj) then
        begin
          if (aParentAccObj <> nil) and (DcNode.ContainsKey(aParentAccObj)) then
            pPNode := DcNode[aParentAccObj]
          else
            pPNode := nil;

          sName := Trim(LowerCase(GetObjectName(aAccObj, varChild)));
//          if sName = '' then
//            exit;
          if GetObjectRoleString(aAccObj, varChild, @arrRoleStr) then
            sRole := LowerCase(DeleteNullTail(String(@arrRoleStr)));
//          if (sRole <> '텍스트') and (sRole <> '편집할 수 있는 텍스트') then
//            exit;

          pData := VT_AddChildDataN(vtTree, pNode, pPNode);
          ZeroMemory(pData, SizeOf(TAccEnt));
          pData.sName := sName;
          pData.sRole := sRole;
          pData.sVal := GetObjectValue(aAccObj, varChild);
          pData.nLevel := nLevel;
          if not DcNode.ContainsKey(aAccObj) then
            DcNode.Add(aAccObj, pNode);

          if (nLv <= nLevel) and
             (sRole <> '텍스트') and (sRole <> '편집할 수 있는 텍스트') then
            SumString(sText, sName, #13#10);
        end;
      except
//        AccObj_SubTitle := nil;
//        VariantClear(varSubTitle);
      end;
    end;

  vtTree.BeginUpdate;
  try
    VT_Clear(vtTree);
    EnumAccessible(h, ProcEnumAccessible);
    mmInfo.Text := sText;
  finally
    VT_ExpandAll(vtTree, true);
    vtTree.EndUpdate;
  end;
end;

procedure TDlgMsaaExtrMain.vtTreeFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  pData: PAccEnt;
begin
  pData := Sender.GetNodeData(Node);
  Finalize(pData^);
end;

procedure TDlgMsaaExtrMain.vtTreeGetHint(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex;
  var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
  HintText := vtTree.Text[Node, Column];
end;

procedure TDlgMsaaExtrMain.vtTreeGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TAccEnt);
end;

procedure TDlgMsaaExtrMain.vtTreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  pData: PAccEnt;
begin
  if Column = 0 then
  begin
    pData := Sender.GetNodeData(Node);
    CellText := Format('[%d] N=%s, R=%s, V=%s', [pData.nLevel, pData.sName, pData.sRole, pData.sVal]);
  end;
end;

end.