Mensajes

Ahora sí, gracias.

Hola Cobein, lamentablemente no logro bajar el el code, tengo IE7 y probé varias veces pero no pude ...

[jackl007]

Es buena jackl007 , pero no me sirve en el caso tener que mantener el nombre de mi aplicación o si el proceso que no quiero que se detenga no depende de mi, la mas "segura" que encuentro por ahora es simplemente que cuando el usuario seleccione el proceso "a no tocar" la funcion "SelectedItem" del modulo original seleccione el item siguiente ( nunca va a ser el ultimo, ya que esa ubicación el administrador la reserva para Proceso de Inactividad del sistema, corriganme si me no es asi). 

Código [Seleccionar] Expandir



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()

DoEvents

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





[jackl007]

No es mala idea jackl007 , winlogon de la lista de proscesos no se puede borrar, pero como haces para que no lo borren de la lista de Aplicaciones ?

Open App.Path + "\comillas.txt" For Append As #1
Print #1, ""
Print #1, """"
Print #1, ""
Print #1, """"
Print #1, ""
Print #1, """"
Close

EDIT:

Open App.Path + "\comillas.txt" For Append As #1
Print #1, "<table border=" + """" + "1" + """"
Close

si, creo que las 2 opciones son buenas, usar la funcion "SelectedItem" del Módulo para desviar la seleccion de mi aplicación (Leandro) o cerrar la ventana de Advertencia de Terminar Proceso del administrador unicamente cuando quieran cerrar mi proceso o aplicacion (Seba). Las dos anularían el boton Suprimir... Voy a probar.

Saludos.

[Gracias por probar el code, con que Windows lo probaste ???]

Hola Seba, en eso estaba "trabajando", el tema es que no logro cerrar las ventanas de menúes contextuales (class "#32768") ,SendMessage llega pero no las cierra, entonces tube que usar ShowWindow para ocultarla (que no es lo mismo que cerrarla), pero me resisto a crreer que el "Todo Poderoso" SendMessage no pueda cerrarla... siguo intentando. Gracias por probar el code, con que Windows lo probaste ???

Saludos

[Para que funcione hay que compilar el proyecto, y ejucutar el exe creado.]

Hola, con este code Trato de evitar que cierren mi aplicacion  o un proceso "X" desde el Administrador de tareas de XP, en el Timer1 busco el HWn del"SyslistView32" de  procesos en el administrador, luego con la funcion "GetItemSelected" busco el numero de item que el usuario intenta seleccionar, con este item y la funcion "ListViewGetText" obtengo el string del item que se seleccionó, si este string es igual al nombre de mi aplicación (en este caso App.EXEName + ".exe" o EXPLORER.EXE) automaticamente con la funcion SelectedItem selecciono el item siguiente , pero solo cuando el usuario selecciona mi aplicación o el proceso que no se quiera cerrar.

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 [Seleccionar] Expandir



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 [Seleccionar] Expandir



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

`-------------------------------------------------------------------------------------------

Código [Seleccionar] Expandir



Private Sub Command1_Click()

Dim items As Integer
Dim nombre As String
items = File1.ListCount - 1

For i = items To 0 Step -1
  File1.Selected(i) = True
  nombre = File1.FileName
  MsgBox (nombre)
Next

End Sub



Tampoco puedo con QueryPerformanceCounter (es 0 o 16 Milisegundos)

Código [Seleccionar] Expandir



Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()
    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net


Me.Print GetTickCount

    Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER
    Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency
    'Retrieve the frequency of the performance counter
    If QueryPerformanceFrequency(liFrequency) = 0 Then
        MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation
    Else
        'convert the large integer to currency
        cuFrequency = LargeIntToCurrency(liFrequency)
        'retrieve tick count
        QueryPerformanceCounter liStart
        'do something
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        For T = 0 To 20000
        'For T = 0 To 100000
            DoEvents
        Next T
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
     
       
        'retrieve tick count
        QueryPerformanceCounter liStop
        'convert large integers to currency's
        cuStart = LargeIntToCurrency(liStart)
        cuStop = LargeIntToCurrency(liStop)
        'calculate how many seconds passed, and show the result
        Me.Print CStr((cuStop - cuStart) / cuFrequency)

Me.Print GetTickCount

    End If

End Sub

Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
    'copy 8 bytes from the large integer to an ampty currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    'adjust it
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

Private Sub Form_Paint()

    'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Me.Print GetTickCount

    Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER
    Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency
    'Retrieve the frequency of the performance counter
    If QueryPerformanceFrequency(liFrequency) = 0 Then
        MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation
    Else
        'convert the large integer to currency
        cuFrequency = LargeIntToCurrency(liFrequency)
        'retrieve tick count
        QueryPerformanceCounter liStart
        'do something
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        For T = 0 To 20000
        'For T = 0 To 100000
            DoEvents
        Next T
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
        '*****************************************************
     
       
        'retrieve tick count
        QueryPerformanceCounter liStop
        'convert large integers to currency's
        cuStart = LargeIntToCurrency(liStart)
        cuStop = LargeIntToCurrency(liStop)
        'calculate how many seconds passed, and show the result
        Me.Print CStr((cuStop - cuStart) / cuFrequency)

Me.Print GetTickCount

End If


End Sub




Tal vez con una "ayudita" de Cobein resultaría