Tengo el siguiente código que es para abrir un ejecutable en un exe.
Option Explicit
Private Declare Function GetGUIThreadInfo Lib "user32.dll" ( _
ByVal idThread As Long, _
ByRef pgui As GUITHREADINFO) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function GetAncestor Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal gaFlags As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
(ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Boolean, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, ByVal _
lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) 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
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type GUITHREADINFO
cbSize As Long
flags As Long
hwndactive As Long
hwndFocus As Long
hwndCapture As Long
hwndMenuOwner As Long
hwndMoveSize As Long
hwndcaret As Long
rcCaret As RECT
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Private Const GA_PARENT = 1
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40
Private udtGUI As GUITHREADINFO
Private udtProc As PROCESS_INFORMATION
Private Function StartProcess(strProgram As String) As Long
Dim udtStartup As STARTUPINFO
Dim udtSec As SECURITY_ATTRIBUTES
Dim lngReturn As Long
udtStartup.cb = Len(udtStartup)
udtSec.nLength = Len(udtSec)
udtSec.bInheritHandle = True
'
' Start the process
'
lngReturn = CreateProcess(strProgram, vbNullString, udtSec, udtSec, _
True, ByVal 0, ByVal 0, vbNullString, _
udtStartup, _
udtProc)
txtProcess.Text = Hex(udtProc.dwThreadId)
lngReturn = GetAncestor(udtProc.hProcess, GA_PARENT)
txtParent.Text = Hex(lngReturn)
udtGUI.cbSize = Len(udtGUI)
'
' Wait for an hWnd to be allocated
'
Do
lngReturn = GetGUIThreadInfo(udtProc.dwThreadId, udtGUI)
DoEvents
Loop Until udtGUI.hwndactive <> 0
StartProcess = udtGUI.hwndactive
End Function
Private Sub PositionWindow(hwnd As Long)
Dim lngReturn As Long
lngReturn = SetWindowPos(hwnd, hwnd, 250&, 0&, 250&, 250&, SWP_NOZORDER Or SWP_SHOWWINDOW)
End Sub
Private Sub cmdIE_Click()
Dim lngReturn As Long
Dim strProg As String
strProg = "C:\Program Files (x86)\FileZilla FTP Client\filezilla.exe"
lngReturn = StartProcess(strProg)
End Sub
Private Sub Command1_Click()
'
' Change the Parent
'
Dim lngReturn As Long
Dim lngStyle As Long
lngReturn = SetParent(udtGUI.hwndactive, Me.hwnd)
Call PositionWindow(udtGUI.hwndactive)
lngReturn = GetAncestor(udtGUI.hwndactive, GA_PARENT)
txtParent.Text = Hex(lngReturn)
End Sub
Private Sub Form_Load()
txtMe.Text = Hex(Me.hwnd)
'
' Scalemode = Pixel
'
Me.ScaleMode = 3
End Sub
Y efectivamente hace lo que yo quiero, abre un programa dentro del formulario, lo probé con la calculadora de Windows e incluso con otros programas
Pero lo que no entiendo es por qué no pasa lo mismo con Chrome, me refiero a que lo abre en una nueva ventana mas no dentro del formulario.
Me urge terminarlo cuanto antes, espero puedan ayudarme, muchas gracias!
Mostrar Mensajes
