Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal HWNDParent As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow 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
 
'//Funcion API para obtener el handle de la aplicación que se quiere menter en el Picture
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
'//Ejecuta el programa
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
'//Función para cerrar la aplicación incrustada
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Const SHOW_FULLSCREEN = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3
Const SWP_NOZORDER = &H4
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&

        Dim HWNDParent As Long

Private Sub Commandmeterchrome_Click()
HWNDParent = 0
   ShellExecute Me.hwnd, "", "chrome.exe", _
    "https://farmsatoshi.com", Environ("programfiles") & "\Google\Chrome\Application\", SW_SHOWMINIMIZED
   Espera (1)  'Espera 1 segundo a que se cargue
   Do While HWNDParent = 0
   HWNDParent = FindWindow("Chrome_WidgetWin_1", vbNullString) 'Obtiene el handle padre
   DoEvents
   Loop
 
Do While N& = 0
N& = SetParent(HWNDParent, Picture1.hwnd) 'Meter la apcliación en el picture
DoEvents
Loop
 
'Ajusta la ventana de Chrome al Picture
Call SetWindowPos(HWNDParent, HWND_TOP, 0, 0, _
Picture1.ScaleWidth, _
Picture1.ScaleHeight, _
SWP_NOZORDER)
End Sub

       Dim ORange As Object
       Dim i As Integer
    
       Set ORange = WebBrowser1.Document.Body.createControlRange()
       Picture2.Cls
       For i = 0 To WebBrowser1.Document.images.length - 1
           Call ORange.Add(WebBrowser1.Document.images.Item(i))
           Call ORange.execCommand("Copy")
           Set Picture2.Picture = Clipboard.GetData
'           MsgBox WebBrowser1.Document.Images.Item(i).GetAttribute("src")
           
           MsgBox WebBrowser1.Document.images.Item(i).GetAttribute("src")
           
'           If WebBrowser1.Document.images.Item(i).GetAttribute("id") = "banner" Then
'               Call ORange.Add(WebBrowser1.Document.images.Item(i))
'               Call ORange.execCommand("Copy")
'               Set Picture2.Picture = Clipboard.GetData
'               Exit For
'           End If
       Next
    End If

Private Declare Function FindWindow _
    Lib "user32" _
    Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) 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 GetParent _
    Lib "user32" ( _
        ByVal hwnd As Long) As Long
  
Private Declare Function GetWindowText _
    Lib "user32" _
    Alias "GetWindowTextA" ( _
        ByVal hwnd As Long, _
        ByVal lpString As String, _
        ByVal cch As Long) As Long
  
' Retorna la cantidad de caracteres del caption de la ventana
Private Declare Function GetWindowTextLength _
    Lib "user32" _
    Alias "GetWindowTextLengthA" ( _
        ByVal hwnd As Long) As Long
  
    
  
  
  
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long

Private Declare Function SendMessage_Long Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef LParam As Long) As Long

'Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Const BM_CLICK = &HF5&

Private Const WM_KEYUP = &H101
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_CHAR = &H102
Private Const WM_CLOSE = &H10
Private Const WM_QUIT = &H12


Private Const WM_LBUTTONDOWN  As Long = &H201
Private Const WM_LBUTTONUP    As Long = &H202
Private Const VK_SPACE    As Long = &H20
Private Const VK_ESCAPE    As Long = &H1B



Private Sub Command2_Click()
  Dim Ret As Long, Handle As Long, hParent
  Dim Buffer As String
  Dim ClassName As String
  Dim Caption_Ventana As String
  Dim bwnd As Long, ChildRet As Long
  Dim strBuff As String, ButCap As String

  
    Handle = FindWindow("#32770", vbNullString)
    If Handle <> 0 Then
'        SendMessage Handle, WM_CLOSE, 0, 0
    
        hParent = GetParent(Handle)
    '    MsgBox hParent
        ClassName = Space$(128)
        'Recupera el Classname y lo devuelve en el Buffer
        Ret = GetClassName(Handle, ClassName, 128)
          
        'Extraemos el nombre de la clase
        ClassName = LCase(Left$(ClassName, Ret))
          
        ' Cantidad de caracteres del texto
        Caption_Ventana = String(GetWindowTextLength(Handle), Chr$(0))
        'Retorna el caption
        Call GetWindowText(Handle, Caption_Ventana, 100)
    
        ChildRet = FindWindowEx(Handle, ByVal 0&, "Button", vbNullString)
        If ChildRet <> 0 Then
            strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
            GetWindowText ChildRet, strBuff, Len(strBuff)
            ButCap = strBuff
            Do While ChildRet <> 0
                '~~> Check if the caption has the word "Open"
                '~~> For "Save" or "Cancel", replace "Open" with
                '~~> "Save" or "Cancel"
    '            MsgBox ButCap
                If InStr(1, ButCap, "Aceptar") Then
                    '~~> If this is the button we are looking for then exit
                    OpenRet = ChildRet
                    Exit Do
                End If
        
                '~~> Get the handle of the next child window
                ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                '~~> Get the caption of the child window
                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                GetWindowText ChildRet, strBuff, Len(strBuff)
                ButCap = strBuff
            Loop
            If OpenRet <> 0 Then
    '            MsgBox "The Handle of Open Button is : " & OpenRet
                WindowAPI_Click (OpenRet)
            Else
    '            MsgBox "The Handle of Open Button was not found"
            End If
            
            
        Else
    '        MsgBox "Child Window Not Found"
        End If
    End If
    Me.Cls
    Me.Print " Hwnd : " & Handle
    Me.Print " Hwnd Parent : " & hParent
    Me.Print " Nombre de clase : " & ClassName
    Me.Print " Caption de la ventana : " & Caption_Ventana
End Sub
Public Sub WindowAPI_Click(ByVal hwnd As Long)
Dim retVal As Long
retVal = SendMessage_Long(hwnd, WM_LBUTTONDOWN, 0&, ByVal 0&)
retVal = SendMessage_Long(hwnd, WM_LBUTTONDOWN, 0&, ByVal 0&)
retVal = SendMessage_Long(hwnd, WM_KEYUP, VK_SPACE, ByVal 0&)
retVal = SendMessage_Long(hwnd, WM_LBUTTONUP, 0&, ByVal 0&)
End Sub

Private Sub ListarUrl()
Dim i As Integer
    
        List2.Clear
        For i = 0 To WebBrowser1.Document.links.length - 1
            añadirruta (WebBrowser1.Document.links.Item(i))
'            List2.AddItem WebBrowser1.Document.Links.Item(i)
        Next
End Sub

CodigoHTML = WebBrowser1.Document.documentElement.innerHTML
Text1.Text = CodigoHTML


Dim Text As String
Text = WebBrowser1.Document.documentElement.outerHTML
Text1.Text = Text