Keskustelu: Ohjelmointikysymykset: C, VB6: Hiiren klikkaus ilman yhtään APIa

#define _WIN32_WINNT 0x401 // Jos herjaa syntax erroria 'LPINPUT':sta, määritä tämä ennen windows.h:n includeemista

__declspec(naked)UINT SendInputXP(UINT nInputs, LPINPUT pInputs, int cbSize)
{
    __asm
    {
        MOV EAX,0x11F6
        MOV EDX,0x7FFE0300
        CALL DWORD PTR DS:[EDX]
        RETN 0x0C
    }
}

__declspec(naked)UINT SendInputVista(UINT nInputs, LPINPUT pInputs, int cbSize)
{
    __asm
    {
        MOV EAX,0x120D
        MOV EDX,0x7FFE0300
        CALL DWORD PTR DS:[EDX]
        RETN 0x0C
    }
}

 'formiin valikko: Valikko  & sen alle alivalikko: Valinta
Private Type PISTE
    x As Long
    y As Long
End Type
Private Type LAATIKKO
    vasen As Long
    yla As Long
    oikea As Long
    ala As Long
End Type

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemRect Lib "user32" (ByVal hwnd As Long, ByVal kahva_valikko As Long, ByVal uItem As Long, lprcItem As LAATIKKO) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal kahva_valikko As Long, ByVal nPos As Long) As Long

Private Const HIIRI_ABS_LIIKE = &H8000
Private Const HIIRI_VASEN_ALAS = &H2
Private Const HIIRI_VASEN_YLOS = &H4
Private Const HIIRI_LIIKE = &H1
Private Const HIIRI_OIKEA_ALAS = &H8
Private Const HIIRI_OIKEA_YLOS = &H10

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const NAYTTO_X = 0
Const NAYTTO_Y = 1

Private Sub Form_KeyPress(KeyAscii As Integer)

  Dim kahva As Long, kahva_valikko As Long, kahva_valinta As Long
  kahva = Me.hwnd: kahva_valikko = GetMenu(kahva)
  Klikkaa_Valikko_Valinta kahva, kahva_valikko, 0
  kahva_valinta = GetSubMenu(kahva_valikko, 0)
  Klikkaa_Valikko_Valinta kahva, kahva_valinta, 0

End Sub

Private Sub Abs_Koordinaatit(lpPiste As PISTE)
  lpPiste.x = lpPiste.x * (&HFFFF& / GetSystemMetrics(NAYTTO_X))
  lpPiste.y = lpPiste.y * (&HFFFF& / GetSystemMetrics(NAYTTO_Y))
End Sub

Private Sub Klikkaa(p As PISTE)

  mouse_event HIIRI_ABS_LIIKE Or HIIRI_LIIKE, p.x, p.y, 0, GetMessageExtraInfo()
  mouse_event HIIRI_VASEN_ALAS, 0, 0, 0, GetMessageExtraInfo()
  mouse_event HIIRI_VASEN_YLOS, 0, 0, 0, GetMessageExtraInfo()

End Sub

Private Sub Klikkaa_Valikko_Valinta(ByVal kahva As Long, ByVal kahva_valikko As Long, ByVal Pos As Long)

  Dim palute As Long, l As LAATIKKO, p As PISTE
  palute = GetMenuItemRect(kahva, kahva_valikko, Pos, l)
  If palute = 0 Then Exit Sub
  p.x = (l.vasen + l.oikea) / 2
  p.y = (l.yla + l.ala) / 2
  Abs_Koordinaatit p
  Klikkaa p

End Sub

Private Sub Form_Load()

  Dim kahva As Long, p As PISTE
  kahva = Me.hwnd
  Dim kahva_valikko As Long, kahva_valinta As Long
  kahva_valikko = GetMenu(kahva)
  Klikkaa_Valikko_Valinta kahva, kahva_valikko, 0
  kahva_valinta = GetSubMenu(kahva_valikko, 0)
  Klikkaa_Valikko_Valinta kahva, kahva_valinta, 0
  p.x = &HFFFF& / 2: p.y = &HFFFF& / 2: Klikkaa p
  Me.AutoRedraw = True
  Print vbCrLf & "  Painna jotain näppäintä..."

End Sub

Private Sub Valinta_Click()
  MsgBox "JEE!"
End Sub

'tee ekas testiohjelma (ladattava.exe)
'formi & nappi
'Command1_Click(): MsgBox "JEE!"

'...ja testaa sit tällä...
'referenssi: Microsoft WMI Scripting V1.2 Library
'(C:\WINDOWS\system32\wbem\wbemdisp.TLB)

Private Declare Function SetForegroundWindow Lib _
"user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function SetActiveWindow Lib _
"user32" (ByVal hwnd As Long) As Long

Private prosessit, prosessi

Private Sub Form_Load()
  If App.PrevInstance Then End
  tsekkaaLadattava
  SetActiveWindow Me.hwnd
End Sub

Private Sub Form_Paint()
  'VAROITUS! älä kytke: Click, KeyPress tai Key/MouseDown tapahtumiin
  theJutska
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  'Vain testaamisen...
  'VAROITUS! älä kytke: Click, KeyPress tai Key/MouseDown tapahtumiin
   theJutska
  'äläkä sorru poistamaan koodia Form_Paint -tapahtumasta
  'ja iskemään mainoksiasi StartUp-formille...
  'KOSKA OLET SILLOIN VAARASSA SEKAANTUA LAITTOMUUKSIIN!!!
End Sub

Sub theJutska()

   Set prosessit = GetObject _
  ("winmgmts:{impersonationLevel=impersonate}") _
  .InstancesOf("Win32_Process")
  For Each prosessi In prosessit
    With prosessi
      If LCase(.Name) = "ladattava.exe" Then
        Dim kama As WbemScripting.SWbemProperty
        SetForegroundWindow Me.hwnd
        For Each kama In .Properties_
          Dim arvo: arvo = kama.Value
          If Not IsNull(arvo) And IsNumeric(arvo) Then
           SetActiveWindow CLng(arvo)
           'mikäli focus sattuisi olemaan,
           'VAIKKAPA Cancel buttonilla...
           'edellinen kontrolli:
           'SendKeys "^{TAB}",true 'Ctrl + Tab
           'seuraava kontrolli:
           'SendKeys "{TAB}",true
            SendKeys "{ENTER}", True
        End If
        Next kama
      End If
    End With
  Next
  Set prosessit = Nothing
  'Unload Me

End Sub

Sub tsekkaaLadattava()

  Dim rullaa As Boolean, masiina
  Dim objekti, ohjelma, simpukka
  Set prosessit = GetObject _
  ("winmgmts:{impersonationLevel=impersonate}") _
  .InstancesOf("Win32_Process")
  For Each prosessi In prosessit
    With prosessi
      If LCase(.Name) = "ladattava.exe" Then
        rullaa = True: Exit For
      End If
    End With
  Next
  If Not rullaa Then
    masiina = "."
    ohjelma = App.Path & "\" & "ladattava.exe"
    'testipolku...
    'ohjelma = Environ("userprofile") & "\Työpöytä\ladattava.exe"
    Set prosessit = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & _
    masiina & "\root\cimv2")
    Set prosessi = prosessit.Get("Win32_Process")
    Set objekti = prosessi.Methods_( _
    "Create").InParameters.SpawnInstance_
    objekti.CommandLine = ohjelma
    Set simpukka = prosessit.ExecMethod( _
    "Win32_Process", "Create", objekti)
    Set simpukka = Nothing: Set objekti = Nothing
    Set prosessi = Nothing: Set prosessit = Nothing
  End If

End Sub