Mensajes

Otra Opcion:

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
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

'Abre un proceso para poder obtener el path ( Retorna el handle )
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
'Obtiene el nombre del proceso a partir de un handle
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
' Cierra y libera el proceso abierto con OpenProcess
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)

Function ProcIDFromWnd(ByVal hwnd As Long) As Long

Dim idProc As Long:
'crea PID de un HWnd
GetWindowThreadProcessId hwnd, idProc
'retorno del PID
ProcIDFromWnd = idProc

End Function

Private Sub Command1_Click()

Shell "calc"

Dim Handle_Proceso As Long: Dim Buffer As String
Dim ret As Long: Dim Ruta As String

Dim Handle As Long: Handle = FindWindow("SciCalc", vbNullString)
'MsgBox ProcIDFromWnd(Handle)
Handle_Proceso = OpenProcess(PROCESS_QUERY_INFORMATION + PROCESS_VM_READ, 0, ProcIDFromWnd(Handle))
If Handle_Proceso <> 0 Then
  Buffer = Space(255) ' Crea un buffer para almacenar el nombre y ruta
  ret = GetModuleFileNameExA(Handle_Proceso, 0, Buffer, 255)    ' Le pasa el Buffer al Api y el Handle
  Ruta = Left(Buffer, ret)   ' Le elimina los espacios nulos a la cadena devuelta
End If

ret = CloseHandle(Handle_Proceso) 'Cierra el proceso abierto

MsgBox Ruta 'Muestra la ruta del proceso

'cierro la calculadora
Call SendMessage(FindWindow("SciCalc", vbNullString), &H112, &HF060&, 0)
End

End Sub



Saludos

'Recupera el Handle de la ventana padre de una ventana o control
Private Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long

[Seba]

Si Seba, creo que el ej. de la api guide que se refiere es EncryptFile, pero funciona perfecto (solo en NTF5, no en FAT 32), el archivo test.txt creado en  "c:\" queda cifrado para otro usuario del equipo.

Código [Seleccionar] Expandir



'Note: Encryptfile only works on NTFS 5
Private Declare Function EncryptFile Lib "ADVAPI32" Alias "EncryptFileA" (ByVal lpFileName As String) As Boolean
Private Declare Function DecryptFile Lib "ADVAPI32" Alias "DecryptFileA" (ByVal lpFileName As String, ByVal dwReserved As Long) As Boolean
Const mFile = "c:\test.txt"

Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
   
    Open "c:\test.txt" For Append As #1
    Print #1, "1"
    Close
   
    Encrypt mFile

End Sub
Sub Encrypt(sFile As String)
    If EncryptFile(mFile) Then
        MsgBox "The file's succesfully encrypted. Log in as another user and try to access this file."
    Else
            MsgBox "NO"
    End If
End Sub
Sub Decrypt(sFile As String)
    If DecryptFile(mFile, 0) = True Then
        MsgBox "The file's succesfully decrypted."
    End If
End Sub



Tranquilo, Cobein, que buen regalo no habia visto este code, saludos.

[Seba]

Gracias Seba, no devuelve el Hwnd pero GetLabelCaption y GetLabelName creo que me van a servir, voy intentar averiguar si el Long que devuelven puede tener alguna relación con el Hwnd.

Gracias y Saludos

[propiedades]

Hola ricardovinzo , tal vez a mi visual le falten "propiedades", podrias chequear si Msgbox Label1.Hwnd te devuelve el long ?

Gracias y saludos.

Hola, alguien sabe como conocer el Hwn de un label creado con VB6 ?

Saludos

[MouseLeave]

MouseLeave "rebuscado" para Label (para text seria mas directo por el Hwn)

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type RECT
    left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Form_Load()

Text1.Appearance = Label1.Appearance
Text1.BorderStyle = Label1.BorderStyle
Text1.Top = Label1.Top
Text1.left = Label1.left
Text1.Height = Label1.Height
Text1.Width = Label1.Width

Text1.Visible = False

Label1.BackColor = vbBlack
Label1.ForeColor = vbWhite
Label1.Alignment = 2
Label1.FontBold = True

Timer1.Interval = 50

End Sub

Private Sub Timer1_Timer()

Dim TR1 As RECT
Dim TR2 As RECT

Dim Left1 As Integer
Dim Left2 As Integer
Dim Top1 As Integer
Dim Top2 As Integer

Dim Point As POINTAPI

GetCursorPos Point

Call GetWindowRect(Text1.hwnd, TR1)
Call GetClientRect(Text1.hwnd, TR2)

Left1 = TR1.left
Left2 = TR1.left + (Label1.Width / 15)
Top1 = TR1.Bottom - TR2.Bottom
Top2 = TR1.Bottom - TR2.Bottom + (Label1.Height / 15)

If Point.X > Left1 And Point.X < Left2 And Point.Y > Top1 And Point.Y < Top2 Then
Label1.BackColor = vbRed
Else
Label1.BackColor = vbBlack
End If

End Sub



Nota: puede servir tambien para saber si en una aplicacion externa a la nuestra  estan pasando el mouse sobre un control .

Saludos

Sí locoedu, si a vos te sirve está bien, pero si tenés que impedir que cierren un proceso que no es tuyo, como harías ??? , por eso en el code puse como a ejemplo el EXPLORER.EXE y/o app.EXEname .

Saludos

Son datos para que la funcion API FindWindows te informe el Hwn de una ventana , el primer string se refiere a la clase de la ventana (lpClassName) y el segundo a su título.
En google + lpClassName vas a encontrar mucho del tema.

saludos