Visual Basic.NET - PARA LOS QUE TIENEN ENDESA

   
Vista:

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
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

PARA LOS QUE TIENEN ENDESA

Publicado por neotecnowindows (15 intervenciones) el 05/11/2012 14:08:26
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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



Nota Tenéis que modificar donde pone 'CAMBIAR' y poner vuestros datos de acceso a Endesa Online.- Este si funciona en visual basic 2010 y 2012. Algunas cosas no hacen falta, sobre todo las declaraciones. Están como base para otras cosas, pero da igual.
Tengo que añadiros más datos. Los pertenecientes al Form2 y los correspondientes al Módule 1
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

PARA LOS QUE TIENEN ENDESA

Publicado por neotecnowindows (15 intervenciones) el 05/11/2012 14:19:20
Datos para la Form2
----------
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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


Os pongo el Module 1 por la tarde que tengo que salir ya.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

PARA LOS QUE TIENEN ENDESA

Publicado por neotecnowindows (15 intervenciones) el 05/11/2012 15:04:42
Código del módule 1
-------------------------
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
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


Nota.- Como hay que tener una picture de endesa y como aquí no puede ponerse, voy a preparar un vídeo en youtube (os pondré aquí la referencia) y así veis como es y podéis parar el vídeo, hacer un Imprimer Pantalla y después recortar la picture y terminada en .png
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

PARA LOS QUE TIENEN ENDESA

Publicado por neotecnowindows (15 intervenciones) el 05/11/2012 15:54:42
Esta es la dirección del video


Os recomiendo también leer el web: vbnet.mvps.org de donde he sacado el módule 1.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar