Страницы: 1
RSS
SendInput не работает в x64
 

Помогите подправить код для того, чтобы он заработал в x64 офисе

нужно изменить dwExtraInfo на LongPtr и подправить размерность GENERALINPUT?

Код
Const VK_H = 72, VK_E = 69, VK_L = 76, VK_O = 79, KEYEVENTF_KEYUP = &H2, INPUT_MOUSE = 0, INPUT_KEYBOARD = 1, INPUT_HARDWARE = 2
Type MOUSEINPUT: dx As Long: dy As Long: mouseData As Long: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type KEYBDINPUT: wVk As Integer: wScan As Integer: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type HARDWAREINPUT: uMsg As Long: wParamL As Integer: wParamH As Integer: End Type
Type GENERALINPUT: dwType As Long: xi(0 To 23) As Byte: End Type
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Sub go1()
AppActivate "Блокнот"
SendKey VK_H: SendKey VK_E: SendKey VK_L: SendKey VK_L: SendKey VK_O
End Sub
Sub SendKey(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = bKey
KInput.dwFlags = 0
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
KInput.wVk = bKey
KInput.dwFlags = KEYEVENTF_KEYUP
GInput(1).dwType = INPUT_KEYBOARD
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(2, GInput(0), Len(GInput(0)))
End Sub

Изменено: KUDRIN - 26.03.2020 14:40:23
 
Код
Sub test()
  AppActivate "Блокнот"
  With CreateObject("WScript.Shell")
    .SendKeys "HELLO"
  End With
End Sub
Владимир
 
Цитата
.SendKeys
SendKeys  это не SendInput
Изменено: KUDRIN - 26.03.2020 13:26:08
 
Можно попробовать так:

Код
#If Win64 Then
Type GENERALINPUT: dwType As LongPtr: xi(0 To 31) As Byte: End Type
#Else
Type GENERALINPUT: dwType As LongPtr: xi(0 To 23) As Byte: End Type
#End If
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As LongPtr, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Изменено: sokol92 - 26.03.2020 14:39:52
Владимир
 
Цитата
Можно попробовать так:
Работает на x64
Изменено: KUDRIN - 26.03.2020 14:45:58
 
и так тоже можно
Код
Const VK_H = 72: Const VK_E = 69: Const VK_L = 76: Const VK_O = 79
Const KEYEVENTF_KEYUP = &H2: Const INPUT_MOUSE = 0: Const INPUT_KEYBOARD = 1: Const INPUT_HARDWARE = 2
Type HARDWAREINPUT: uMsg As Long: wParamL As Integer: wParamH As Integer: End Type
#If VBA7 And Win64 Then
    Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As Any, ByVal cbsize As Long) As Long
#Else
    Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As Any, ByVal cbsize As Long) As Long
#End If
Type KEYBDINPUT
    wVk As Integer: wScan As Integer
    #If VBA7 And Win64 Then
        dwFlags As LongPtr: time As LongLong: dwExtraInfo As LongPtr
    #Else
        dwFlags As Long: time As Long: dwExtraInfo As Long
    #End If
End Type

Type MOUSEINPUT
    dX As Long: dY As Long: mouseData As Long: dwFlags As Long
    #If VBA7 And Win64 Then
        time As LongLong: dwExtraInfo As LongPtr
    #Else
        time As Long: dwExtraInfo As Long
    #End If
End Type
Type GENERALINPUT
    dwType As Long: kbi As KEYBDINPUT
End Type

Sub go1()
    Dim inputs() As GENERALINPUT
    AppActivate "Блокнот"
    ReDim inputs(4)
    
    For Each Key In Array(VK_H, VK_E, VK_L, VK_L, VK_O)
        inputs(i).dwType = INPUT_KEYBOARD
        inputs(i).kbi.dwFlags = KEYEVENTF_KEYUP
        inputs(i).kbi.wVk = Key
        i = i + 1
    Next
    
    SendInput 5, inputs(0), Len(inputs(0)) + 8
End Sub
Изменено: Андрей Лящук - 26.03.2020 17:18:41
 
Цитата
и так тоже можно
Прекрасно
Коротко и без лишних операций
Изменено: KUDRIN - 27.03.2020 16:06:31
Страницы: 1
Наверх