If t = App.EXEName + ".exe" Then Call SelectedItem(Handle, x)
If t = "EXPLORER.EXE" Then Call SelectedItem(Handle, x)
Para que funcione hay que compilar el proyecto, y ejucutar el exe creado.
Por último lo probé en windows Xp (pro) , seria bueno probarlo en otros windows.
FORMULARIO (MODIFICADO EL 09/12/2008)
Código:
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dim Handle As Long: Dim x As Long
Dim t As String: Dim t2 As String
Private Sub Form_Load()
App.TaskVisible = False
Timer1.Interval = 15
End Sub
Private Sub Timer1_Timer()
Handle = FindWindow("#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "SyslistView32", vbNullString)
x = GetItemSelected(Handle)
t = ListViewGetText(Handle, 0, x - 1)
'Me.Caption = FindWindow("#32770", vbNullString) & " " & x & " " & Len(t)
If FindWindow("#32770", vbNullString) <> 0 And x <> 0 And t = "" Then
Call SendMessage(FindWindow("#32770", vbNullString), &H112, &HF060&, 0)
keybd_event &H12, 0, 0, 0: keybd_event &H12, 0, &H2, 0
End If
If FindWindow("#32770", vbNullString) <> 0 And x <> 0 And t = "" Then
If FindWindow("#32768", vbNullString) <> 0 Then
Call SendMessage(FindWindow("#32770", vbNullString), &H112, &HF060&, 0)
keybd_event &H12, 0, 0, 0: keybd_event &H12, 0, &H2, 0
End If
End If
If t = App.EXEName + ".exe" Then Call SelectedItem(Handle, x)
If t = "EXPLORER.EXE" Then Call SelectedItem(Handle, x)
End Sub
MODULO
Código:
Option Explicit
Private Type LVITEM
mask As Long
iItem As Long
iSubitem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Const LVIF_IMAGE = &H2
Private Const LVIF_TEXT = &H1
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEM As Long = (LVM_FIRST + 5)
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVIS_SELECTED = &H2
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Private Const LVIF_STATE = &H8&
Private Const PAGE_READWRITE = &H4&
Private Const MEM_RESERVE = &H2000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private hWndlvw As Long
Function ListViewGetText(ByVal hwnd As Long, ByVal iSubitem As Integer, ByVal iItem As Integer) As String
Dim lngProcID As Long, lngProcHandle As Long
Dim typLvItem As LVITEM, strLvItem As String
Dim lngVarPtr1 As Long, lngVarPtr2 As Long
Dim lngMemVar1 As Long, lngMemVar2 As Long
Dim lngMemLen1 As Long, lngMemLen2 As Long
Call GetWindowThreadProcessId(hwnd, lngProcID)
If lngProcID <> 0 Then
lngProcHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lngProcID)
If lngProcHandle <> 0 Then
strLvItem = String(255, vbNullChar)
lngVarPtr1 = StrPtr(strLvItem)
lngVarPtr2 = VarPtr(typLvItem)
lngMemLen1 = LenB(strLvItem)
lngMemLen2 = LenB(typLvItem)
lngMemVar1 = VirtualAllocEx(lngProcHandle, 0, lngMemLen1, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
lngMemVar2 = VirtualAllocEx(lngProcHandle, 0, lngMemLen2, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
With typLvItem
.cchTextMax = 255
.iItem = iItem
.iSubitem = iSubitem
.mask = LVIF_TEXT
.pszText = lngMemVar1
End With
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar2, ByVal lngVarPtr2, lngMemLen2, 0)
Call SendMessage(hwnd, LVM_GETITEM, ByVal 0, ByVal lngMemVar2)
Call ReadProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
strLvItem = StrConv(strLvItem, vbUnicode)
strLvItem = Left(strLvItem, InStr(1, strLvItem, vbNullChar) - 1)
ListViewGetText = strLvItem
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar1, lngMemLen1, MEM_RELEASE)
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar2, lngMemLen2, MEM_RELEASE)
Call CloseHandle(lngProcHandle)
End If
End If
End Function
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
hWndlvw = FindWindowEx(hwnd, 0&, "ListView20WndClass", "")
EnumWindowsProc = (hWndlvw = 0) 'Stop when we find first listview
End Function
'Public Function FindListView() As Long
' EnumWindows AddressOf EnumWindowsProc, 0&
' FindListView = hWndlvw
'End Function
Public Function SelectedItem(ByVal hwnd As Long, ItemPos As Long)
Dim lProcID As Long
Dim hProc As Long
Dim lxprocLVITEM As Long
Dim LV_ITEM As LVITEM
GetWindowThreadProcessId hwnd, lProcID ' Get the process ID in which the ListView is running
If lProcID <> 0 Then
hProc = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lProcID) ' makwe sure we have read write permissions in the process space
If hProc <> 0 Then
lxprocLVITEM = VirtualAllocEx(hProc, 0, LenB(LV_ITEM), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE) ' Grab enough memory in the other procedure's space to hold our LV_ITEM
' Set up our local LV_ITEM to change the selected item
LV_ITEM.mask = LVIF_STATE
LV_ITEM.state = True
LV_ITEM.stateMask = LVIS_SELECTED
' Copy the local LV_ITEM into the space we reserved in the foreign process
WriteProcessMemory hProc, ByVal lxprocLVITEM, ByVal VarPtr(LV_ITEM), LenB(LV_ITEM), 0
' Now send the message, but pass the address of the copy of our LV_ITEM that now exists in the foreign process instead of our local versiony
SendMessage hwnd, LVM_SETITEMSTATE, ItemPos, ByVal lxprocLVITEM
' Clean up
VirtualFreeEx hProc, ByVal lxprocLVITEM, LenB(LV_ITEM), MEM_RELEASE
CloseHandle hProc
End If
End If
End Function
Function GetListViewCount(ByVal hwnd As Long) As Long
GetListViewCount = SendMessage(hwnd, LVM_GETITEMCOUNT, 0, ByVal 0)
End Function
Function GetItemSelected(hwnd As Long) As Long
Dim i As Long, Index As Long
For i = 1 To GetListViewCount(hwnd)
Index = SendMessage(hwnd, LVM_GETITEMSTATE, i - 1, ByVal LVIS_SELECTED)
If Index > 0 Then
GetItemSelected = i
Exit For
End If
Next
End Function
PD 1: Las Funciones "GetItemSelected" y "ListViewGetText" me las pasó Leandro hace unos meses.
PD 2: Si el code le sirve a alguien y lo podemos mejorar seria buenisimo, y si no sirve lo descartamos
EDITADO 09/12/2008
PD 3: A continuación dejo el código original del formulario que publiqué en este mensaje, mantengo este code (que modifiqué mas arriba) porque las respuestas de Seba123neo y de Leandro que siguen a continuación se refieren a este code, pero repito el que vale es el code del formulario que está mas arriba
FORMULARIO ORIGINAL (no válido)
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow _
Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
Private Declare Function IsWindowEnabled Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, ByVal fEnable As Long) As Long
Dim Handle As Long
Dim Handle2 As Long
Dim Index As Long
Dim ret As Long
Private Sub Form_Load()
Timer1.Interval = 25
Timer2.Interval = 25
Timer2.Enabled = False
'Me.Hide
End Sub
Private Sub Timer1_Timer()
Handle = FindWindow("#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "SyslistView32", vbNullString)
Dim x As Long: x = GetItemSelected(Handle)
Dim t As String: t = ListViewGetText(Handle, 0, x - 1)
If t = "EXPLORER.EXE" Or t = "Project1.exe" Or t = "Project1" Then
Timer2.Enabled = True
'Handle = FindWindow("#32770", vbNullString)
'Call SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, CLng(0))
Handle = FindWindow("#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "Button", "&Terminar proceso")
ret = IsWindowEnabled(Handle)
If ret = 1 Then Call EnableWindow(Handle, 0)
Handle = FindWindow("#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "#32770", vbNullString)
Handle = FindWindowEx(Handle, 0, "Button", "&Finalizar tarea")
ret = IsWindowEnabled(Handle)
If ret = 1 Then Call EnableWindow(Handle, 0)
Else
Timer2.Enabled = False
End If
End Sub
Private Sub Timer2_Timer()
Handle2 = FindWindow("#32768", vbNullString)
Call ShowWindow(Handle2, SW_HIDE)
End Sub
`-------------------------------------------------------------------------------------------