
PARA LOS QUE TIENEN ENDESA
Publicado por neotecnowindows (15 intervenciones) el 05/11/2012 13:49:53
Falta algo. No funciona. Ahora lo pongo
Valora esta pregunta


0
Imports System.Resources
Imports System.Runtime.InteropServices
Public Class Form1
Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageID As Long, _
ByVal lngMilliseconds As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_CLOSE = &H10
Private hWnd As Long
Private Const MsgTitle As String = "EndesaNuevo"
Public Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cButtons As Integer, ByVal dwExtraInfo As Integer)
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Dim contador As Integer
Private ReadyToUnload As Boolean
Private TimerExpired As Boolean
Private pDisp As Object
Private theElementCollection As HtmlElementCollection
Public Property IsScriptEnabled As Boolean
Private Sub Form1_Click(sender As Object, e As System.EventArgs) Handles Me.Click
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
WebBrowser1.Navigate("http://www.endesaonline.com/canal/login/login2.asp?lang=es")
End Sub
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
'
End Sub
Private Sub WebBrowser1_Disposed(sender As Object, e As System.EventArgs) Handles WebBrowser1.Disposed
End Sub
Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
contador = contador + 1
While Not WebBrowser1.ReadyState = WebBrowserReadyState.Complete
Application.DoEvents()
End While
If (WebBrowser1.ReadyState = WebBrowserReadyState.Complete) Then
If contador = 1 Then
WebBrowser1.Document.Window.Document.GetElementById("id").SetAttribute("Value", "CAMBIAR")
WebBrowser1.Document.Window.Document.InvokeScript("chk")
WebBrowser1.Document.Window.Document.GetElementById("Clave_sin").SetAttribute("Value", "CAMBIAR")
theElementCollection = WebBrowser1.Document.GetElementsByTagName("input")
For Each curElement As HtmlElement In theElementCollection
If curElement.GetAttribute("value").Equals("Enviar") Then
Form2.ShowDialog() ' sin esto no funciona el Click. Ha sido providencial
curElement.InvokeMember("click")
End If
Next
End If
End If
End Sub
Private Sub WebBrowser1_NewWindow(sender As Object, e As System.ComponentModel.CancelEventArgs) Handles WebBrowser1.NewWindow
Application.Exit()
End Sub
imports System.Runtime.InteropServices
Public Class Form2
Public Delegate Function CallBack( _
ByVal nCode As Integer, _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As Integer
Dim WH_MOUSE As Integer = 7
Shared hHook As Integer = 0
Private hookproc As CallBack
<DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
Public Overloads Shared Function SetWindowsHookEx _
(ByVal idHook As Integer, ByVal HookProc As CallBack, _
ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
End Function
'Import for the CallNextHookEx function.
<DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
Public Overloads Shared Function CallNextHookEx _
(ByVal idHook As Integer, ByVal nCode As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
End Function
'Import for the UnhookWindowsHookEx function.
<DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
Public Overloads Shared Function UnhookWindowsHookEx _
(ByVal idHook As Integer) As Boolean
End Function
'Point structure declaration.
<StructLayout(LayoutKind.Sequential)> Public Structure Point
Public x As Integer
Public y As Integer
End Structure
'MouseHookStruct structure declaration.
<StructLayout(LayoutKind.Sequential)> Public Structure MouseHookStruct
Public pt As Point
Public hwnd As Integer
Public wHitTestCode As Integer
Public dwExtraInfo As Integer
End Structure
Private WithEvents mytimer As New Timer
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs)
'
End Sub
Private Sub Form2_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
mytimer.Interval = 500
mytimer.Start()
End Sub
Private Sub Form2_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
End Sub
Private Sub mytimer_Tick(sender As Object, e As System.EventArgs) Handles mytimer.Tick
Close()
End Sub
End Class
Option Explicit On
Module Module1
'Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'needed public for the Timer event
Public hwndMsgBox As Long
'custom user-defined type to pass
'info between procedures - easier than
'passing a long list of variables.
'Needed public for the Timer event
Public Structure CUSTOM_MSG_PARAMS
Dim hOwnerThread As Long
Dim hOwnerWindow As Long
Dim dwStyle As Long
Dim bUseTimer As Boolean
Dim dwTimerDuration As Long
Dim dwTimerInterval As Long
Dim dwTimerExpireButton As Long
Dim dwTimerCountDown As Long
Dim sTitle As String
Dim sPrompt As String
End Structure
Public cmp As CUSTOM_MSG_PARAMS
'Windows-defined uType parameters
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
'Windows-defined MessageBox return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
'This section contains user-defined constants
'to represent the buttons/actions we are
'creating, based on the existing MessageBox
'constants. Doing this makes the code in
'the calling procedures more readable, since
'the messages match the buttons we're creating.
Public Const MB_SELECTBEGINSKIP As Long = MB_ABORTRETRYIGNORE
Public Const IDSELECT = IDABORT
Public Const IDBEGIN = IDRETRY
Public Const IDSKIP = IDIGNORE
Public Const IDPROMPT = &HFFFF&
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
'UDT for passing data through the hook
Private Structure MSGBOX_HOOK_PARAMS
Dim hwndOwner As Long
Dim hHook As Long
End Structure
'need this declared at module level as
'it is used in the call and the hook proc
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As [String], _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As [String] 'As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As [String] 'As Long
'When the message box is about to be shown,
'we'll change the titlebar text, prompt message
'and button captions
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox - save that
'for the timer event
hwndMsgBox = wParam
'the ID's of the buttons on the message box
'correspond exactly to the values they return,
'so the same values can be used to identify
'specific buttons in a SetDlgItemText call.
SetDlgItemText(wParam, IDSELECT, "Select..")
SetDlgItemText(wParam, IDBEGIN, "Begin")
SetDlgItemText(wParam, IDSKIP, "Skip")
'we're done with the dialog, so release the hook
UnhookWindowsHookEx(MHP.hHook)
End If
'return False to let normal processing continue
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'Set up the hook
hInstance = GetWindowLong(cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MHP
.hwndOwner = cmp.hOwnerWindow
'.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
End With
'(re)set the countdown value to 0
cmp.dwTimerCountDown = 0
'if bUseTimer, enable the timer. Because the
'MessageBox API acts just as the MsgBox function
'does (that is, creates a modal dialog), control
'won't return to the next line until the dialog
'is closed. This necessitates our starting the
'timer before making the call.
'
'However, timer events will execute once the
'modal dialog is shown, allowing us to use the
'timer to dynamically modify the on-screen message!
With Form1.Timer1
.Interval = cmp.dwTimerInterval
.Enabled = cmp.bUseTimer
End With
'call the MessageBox API and return the
'value as the result of the function
TimedMessageBoxH = MessageBox(cmp.hOwnerWindow, _
cmp.sPrompt, _
cmp.sTitle, _
cmp.dwStyle)
'in case the timer event didn't
'suspend the timer, do it now
Form1.Timer1.Enabled = False
End Function
'***********************************************
End Module