ObjectFromLresult 사용한 웹문서(HTMLDocument)서 개체 얻기

예제 초기 화면입니다.

원형 이미지로 마우스로 드래그 하여 웹문서 포함하는 윈도우를 지정하면 해당 윈도우의 소스를 얻어옵니다.

요즘은 응용프로그램 내에 웹페이지를 표시하는 윈도우를 포함하는 경우가 많습니다. 그럴때 사용하면 유용합니다.

소스는 다음과 같습니다.
Option Explicit ' 모든 변수는 선언된 뒤에 사용할 수 있다.

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long ' 현재 커서의 위치를 얻는다.
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long ' 현재 윈도우의 부모 윈도우 핸들을 얻는다.
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' 윈도우의 사각형 좌표를 얻는다.
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long ' 사각형 영역을 생성한다.
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long ' 사각형 영역을 합친다.
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long ' 사각형 영역을 윈도우에 적용한다.
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long ' 포인터 아래의 윈도우의 핸들을 얻는다.
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long ' 윈도우를 위치,크기등을 변경
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long ' 위도우의  z순서를 정한다.
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long ' 부모 윈도우를 변경시킨다.
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As GUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long

Private Type GUID
  Data1         As Long
  Data2         As Integer
  Data3         As Integer
  Data4(0 To 7) As Byte
End Type

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const MIIM_BITMAP = &H80 ' hbmpItem 멤버
Private Const MIIM_CHECKMARKS = &H8 ' hbmpChecked,hbmpUnchecked 멤버
Private Const MIIM_DATA = &H20 ' dwItemData 멤버
Private Const MIIM_FTYPE = &H100 ' fType 멤버
Private Const MIIM_ID = &H2 ' wID 멤버
Private Const MIIM_STATE = &H1 ' fState 멤버
Private Const MIIM_STRING = &H40 ' dwTypeData 멤버
Private Const MIIM_SUBMENU = &H4 ' hSubMenu 멤버
Private Const MIIM_TYPE = &H10 ' fType, dwTypeData 멤버

Private Const MF_SEPARATOR = &H800& ' 분리선
Private Const MFT_SEPARATOR = MF_SEPARATOR ' 분리선

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const RGN_DIFF = 4

' Image Key. 이미지 키
Private Const IK_GetWindow As String = "Window" ' 윈도우를 찾을 경우의 픽처박스
Private Const IK_Point As String = "Point" ' 윈도우를 찾을 경우 마우스 커서 포인터
Private Const IK_NotDo As String = "WindowPoint" ' 윈도우를 찾지 않을  경우의 픽처박스
Private Const BufferLength As Long = 128 ' 버퍼의 길이

Private Const WM_HTML_GETOBJECT = "WM_HTML_GETOBJECT"

Private SignWindowHwnd As Long ' 포인터 아래의 윈도우를 표시하기 위한 픽처박스 핸들
Private BeforeHwnd As Long ' 이전(이 함수가 호출되기 한단계 전의 함수 호출시) 윈도우 핸들

' 픽처 박스의 크기를 해당 윈도우에 맞게 조정한다.
Private Sub WindowSign()
    Dim MousePoint As POINTAPI ' 마우스의 위치
    Dim Windowhwnd As Long ' 마우스 위치의 윈도우 핸들
    Dim WindowPosition As RECT ' 마우스 아래에 있는 위도우의 위치를 나타낸다.
    Dim rgnPic As Long ' 픽처박스에 표식을 제외한 부분 사각형 영역
    Dim rgnSign As Long ' 표식을 나타내는 도형이 표시되는 사각형 영역
    Dim Sha1Width As Long ' 외부 도형의 폭
    Dim Sha2Width As Long ' 내부 도형의 폭
    Dim Sha1Height As Long ' 외부 도형의 높이
    Dim Sha2Height As Long ' 내부 도형의 높이

    Call GetCursorPos(MousePoint) ' 현재 마우스의 위치를 얻는다(픽셀)
    Windowhwnd = WindowFromPoint(MousePoint.x, MousePoint.y) ' 현재 마우스 위치의 상위 윈도우의 핸들을 얻는다.
    If Not CBool(Windowhwnd) Then Exit Sub ' 윈도우 핸들을 얻지 못하였다면
    If BeforeHwnd = Windowhwnd Then Exit Sub ' 이전의 윈도우 핸들과 같다면
    BeforeHwnd = Windowhwnd ' 포인터 아래의 윈도우 핸들을 백업하여 둔다.(다음 호출시 비교하기 위함)
    Call GetWindowRect(Windowhwnd, WindowPosition) ' 마우스 아래에 있는 윈도우의 크기와,위치를 얻는다.
    With WindowPosition
        Sha1Width = .Right - .Left ' 도형의 폭과 높이 계산
        Sha2Width = Sha1Width - 2
        Sha1Height = .Bottom - .Top
        Sha2Height = Sha1Height - 2
        MoveWindow SignWindowHwnd, .Left, .Top, Sha1Width, Sha1Height, True ' 표식을 하는 윈도우의 크기를, 마우스 아래의 윈도우 크기로 한다.
        Call SetWindowPos(SignWindowHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) ' 그 픽처박스를 최상위 폼으로 한다.(표식이 된 윈도우가 이동된 후에 다시 그 윈도우를 지정하개 되면, 표식 픽처 박스가 최상위가 않되는 상황이 발생하기 때문에 이를 방지)
        ' ※ left와 top가 -값을 갖는 경우가 있다.
    End With
    picShape1.Width = Sha1Width ' 해당 윈도우 표시를 위한 외부 사각형
    picShape1.Height = Sha1Height
    picShape2.Width = Sha2Width ' 해당 윈도우 표시를 위한 내부 사각형
    picShape2.Height = Sha2Height
    rgnPic = CreateRectRgn(2, 2, Sha2Width, Sha2Height) ' 도형을 제외한 사각형 영역, 투명하게 할 사각형 영역을 생성
    rgnSign = CreateRectRgn(0, 0, Sha1Width, Sha1Height) ' 픽처박스 전체 크기의 사격형 영역을 생성
    CombineRgn rgnPic, rgnSign, rgnPic, RGN_DIFF ' 픽처 박스 사각형 영역에서, 투명 부분의 사각형을 뺀 사각형 영역을 만든다.
    SetWindowRgn SignWindowHwnd, rgnPic, True ' 그 사각형 영역을 픽처 박스에 적용시킨다. 따라서 표식 부분을 제외한 부분은 투명이 된다.
End Sub

' 메모리이 이 폼이 로드되는 경우 발생
Private Sub Form_Load()
    picWindowMark.ScaleMode = vbPixels ' 픽처박스의 스케일모드를 픽셀단위로 바꾼다
    picWindowMark.Visible = False
    picShape1.Left = 0 ' 표식 외부 사각형 왼쪽 상단 위치 초기화
    picShape1.Top = 0
    picShape2.Left = 1 ' 표식 내부 사각형 왼쪽 상단 위치 초기화
    picShape2.Top = 1
    SignWindowHwnd = picWindowMark.hwnd ' 포인트 아래의 윈도우를 표시하기 위한 핸들
    Call SetParent(SignWindowHwnd, 0) ' 현재 윈도우의 외곽선을 그릴 픽처박스를 바탕화면의 하위로 폼으로 만든다.(따라서 픽처박스가 바탕화면에서 자유자재로 움직일수 있다)
    Set picPointer.Picture = imlList.ListImages(IK_NotDo).Picture ' 윈도 찾기 위한 픽처 박스의 기본 이미지 설정
    Set Screen.MouseIcon = imlList.ListImages(IK_Point).Picture ' 윈도우를 찾는 경우 포인터의 아이콘 이미지 설정
End Sub

' 메모리에서 이 폼에 제거되는 경우 발생
Private Sub Form_Unload(Cancel As Integer)
    Call SetParent(picWindowMark.hwnd, Me.hwnd) ' 외곽선을 표시할 픽처박스의 부모 윈도우를 원래 상태로 되돌린다.
End Sub

Private Sub picPointer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Set picPointer.Picture = imlList.ListImages(IK_GetWindow).Picture
        Screen.MousePointer = vbCustom
        picWindowMark.Visible = True
    End If
End Sub

Private Sub picPointer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Call WindowSign ' 픽처박스의 크기를 해당 윈도우 맞게 크기를 조정한다.
    End If
End Sub

Private Sub picPointer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Set picPointer.Picture = imlList.ListImages(IK_NotDo).Picture
        Screen.MousePointer = vbNormal
        picWindowMark.Visible = False
        GetHTMLSource BeforeHwnd ' 윈도우에 따른 HTML 소스를 얻는다.
    End If
End Sub

Private Sub GetHTMLSource(Whwnd As Long) ' 윈도우 핸들에 의한 웹소스를 얻는다.
    Dim ClassName As String
   
    ClassName = String(100, " ")
    GetClassName Whwnd, ClassName, 100
    If Not InStr(1, ClassName, "Internet Explorer_Server") = 1 Then Exit Sub
    txtHTML.Text = GetHtmlDocFromHwnd(Whwnd).documentElement.innerHTML
End Sub

Private Function GetHtmlDocFromHwnd(ByVal hwnd As Long) As IHTMLDocument2 ' 웹문서 얻기
    Dim ID     As GUID
    Dim lngReg As Long
    Dim lngHnD As Long

    lngHnD = RegisterWindowMessage(WM_HTML_GETOBJECT)
    Call SendMessageTimeout(hwnd, lngHnD, 0, 0, &H2, 1000, lngReg)
    Call ObjectFromLresult(lngReg, ID, 0, GetHtmlDocFromHwnd)
End Function

이전의 WindowFromPoint 함수의 소스와 8~90% 소스는 일치합니다. 여기서는 마지막 부분의 GetHtmlDocFromHwnd 함수 프로시저가 중요한 부분입니다.