elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


  Mostrar Temas
Páginas: [1]
1  Programación / Programación Visual Basic / WM_NCHITTEST en: 16 Agosto 2011, 23:10 pm
Hola, para el q le interese el Mensaje WM_NCHITTEST puede detectar en que lugar de una ventana o control está pasando el puntero del mouse o combinado con un hook al mouse tambien se puede saber donde se está haciendo un click (entre otras cosas)... Abarca el area-cliente, botones de cerrar, maximizar y minimizar, barra de titulo, icono de la barra, bordes derecho, izquierdo, angulos, bordes bixed, etc.

No se trata de un código optimizado, solo un simple concepto para el q no la conoce, saludos

Form

Código
  1.  
  2.  
  3. Option Explicit
  4.  
  5. Private Sub Form_Load()
  6.  Call SetWindowPos(Me.hwnd, &HFFFF, &H0, &H0, &H0, &H0, &H2 Or &H1) 'on top (opcional)
  7.  Call StartHook
  8. End Sub
  9. Private Sub Form_Unload(Cancel As Integer)
  10.   StopHook
  11. End Sub
  12.  
  13.  
  14.  



Module

Código
  1.  
  2.  
  3. Option Explicit
  4.  
  5. 'Modulo: NCHITTEST
  6. 'Autor   : Sergio Desanti (Hasseds)
  7. 'Test    : XP (32 BIT) 
  8.  
  9.  
  10. Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  11.  
  12. Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  13. Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
  14. Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
  15. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  16. Private Type POINTAPI: x As Long: y As Long: End Type
  17. Private Const WM_NCHITTEST = &H84
  18.  
  19. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
  20. Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  21.  
  22. Dim hHook As Long
  23.  
  24. Function Make_lParam(ByVal x As Integer, ByVal y As Integer) As Long
  25.   Make_lParam = x Or (y * &H10000)
  26. End Function
  27.  
  28. Public Sub StartHook()
  29.      hHook = SetWindowsHookEx(&HE, AddressOf MouseProc, App.hInstance, &H0)
  30. End Sub
  31.  
  32. Public Sub StopHook()
  33.     Call UnhookWindowsHookEx(hHook)
  34.     hHook = 0
  35. End Sub
  36.  
  37. Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long
  38.  
  39.   Dim hwndl As Long
  40.   hwndl = WindowFromPoint(lParam.x, lParam.y)
  41.  
  42.   Dim retNCHITTEST As Long
  43.   retNCHITTEST = SendMessage(hwndl, WM_NCHITTEST, &H0&, ByVal Make_lParam(lParam.x, lParam.y))
  44.  
  45.  
  46.   'If wParam = &H201 Then
  47.     If hwndl = Form1.hwnd Then
  48.       Select Case retNCHITTEST
  49.         Case 1:  Form1.Caption = "AREA CLIENTE"
  50.         Case 2:  Form1.Caption = "BARRA DE TITULO"
  51.         Case 3:  Form1.Caption = "ICONO LA BARRA DE TITULO"
  52.         Case 6:  Form1.Caption = "SCROLL HORIZONTAL"
  53.         Case 7:  Form1.Caption = "SCROLL VERTICAL"
  54.         Case 8:  Form1.Caption = "BOTON MINIMIZAR"
  55.         Case 9:  Form1.Caption = "BOTON MAXIMIZAR"
  56.         Case 10: Form1.Caption = "BORDE IZQUIERDO"
  57.         Case 11: Form1.Caption = "BORDE DERECHO"
  58.         Case 12: Form1.Caption = "BORDE SUPERIOR"
  59.         Case 13: Form1.Caption = "BORDE SUPERIOR IZQUIERDO"
  60.         Case 14: Form1.Caption = "BORDE SUPERIOR DERECHO"
  61.         Case 15: Form1.Caption = "BORDE INFERIOR"
  62.         Case 16: Form1.Caption = "BORDE INFERIOR IZQUIERDO"
  63.         Case 17: Form1.Caption = "BORDE INFERIOR DERECHO"
  64.         Case 18: Form1.Caption = "BORDE FIXED"
  65.         Case 20: Form1.Caption = "BOTON CERRAR"
  66.         Case 21: Form1.Caption = "BOTON AYUDA"
  67.         Case Else: Form1.Caption = retNCHITTEST
  68.       End Select
  69.     Else
  70.       Form1.Caption = "FUERA DE VENTANA"
  71.     End If
  72.   'End If
  73.  
  74.   '.......................................................................
  75.    Dim PT As POINTAPI
  76.    Call ClientToScreen(hwndl, PT)
  77.  
  78.    Form1.Cls
  79.    Form1.Print "Coordenada Screen X " & lParam.x
  80.    Form1.Print "Coordenada Screen Y " & lParam.y
  81.  
  82.    If hwndl = Form1.hwnd Then
  83.      Form1.Print
  84.      Form1.Print "Coordenada Control X " & lParam.x - PT.x
  85.      Form1.Print "Coordenada Control Y " & lParam.y - PT.y
  86.    End If
  87.   '.......................................................................
  88.  
  89.   MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam)
  90.  
  91. End Function
  92.  
  93.  
  94.  
2  Programación / Programación Visual Basic / Seriales de Pen-Drives conectados (SRC) en: 21 Junio 2011, 22:01 pm
Retorno = Seriales de Pen-Drives conectados

Código
  1.  
  2. Option Explicit
  3.  
  4. 'Function: FlashSerials
  5. 'Autor   : Sergio Desanti (Hasseds)
  6. 'Thank   : Seba , Cobein, A.Desanti
  7. 'Test    : XP (32 BIT) - W7/UAC (32 BIT)
  8. 'Return  : Serial(ESN) de Pen-Drives conectados
  9. '
  10. Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
  11. Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByRef ClassGuid As GUID, ByVal Enumerator As Long, ByVal hwndParent As Long, ByVal flags As Long) As Long
  12. Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
  13. Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, DeviceInterfaceDetailData As Any, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, DeviceInfoData As Any) As Long
  14. Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
  15.  
  16.  
  17. Private Type GUID
  18.     Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(7) As Byte
  19. End Type
  20.  
  21. Private Type SP_DEVICE_INTERFACE_DATA
  22.     cbSize As Long: InterfaceClassGuid As GUID: flags As Long: Reserved As Long
  23. End Type
  24.  
  25. Private Type SP_DEVINFO_DATA
  26.     cbSize As Long: ClassGuid As GUID: DevInst As Long: Reserved As Long
  27. End Type
  28.  
  29. Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
  30.     cbSize As Long: strDevicePath As String * 260
  31. End Type
  32.  
  33. Private Sub Form_Load()
  34.      AutoRedraw = True
  35.      Print FlashSerials
  36. End Sub
  37.  
  38. Public Function FlashSerials() As String
  39.  
  40.     Dim TGUID As GUID
  41.  
  42.     Call IIDFromString(StrPtr("{a5dcbf10-6530-11d2-901f-00c04fb951ed}"), TGUID)
  43.  
  44.     Dim hDev As Long
  45.     hDev = SetupDiGetClassDevs(TGUID, &H0, &H0, &H12)
  46.     If hDev = -1 Then Exit Function
  47.  
  48.     Dim lCount        As Long
  49.     Dim lSize         As Long
  50.     Dim DEV_DETAIL    As SP_DEVICE_INTERFACE_DETAIL_DATA
  51.     Dim DEV_INFO      As SP_DEVINFO_DATA
  52.     Dim DEV_DATA      As SP_DEVICE_INTERFACE_DATA
  53.  
  54.     DEV_DATA.cbSize = Len(DEV_DATA)
  55.  
  56.     While SetupDiEnumDeviceInterfaces(hDev, &H0, TGUID, lCount, DEV_DATA) <> &H0
  57.       Call SetupDiGetDeviceInterfaceDetail(hDev, DEV_DATA, ByVal &H0, &H0, lSize, ByVal &H0)
  58.       DEV_DETAIL.cbSize = &H5
  59.       DEV_INFO.cbSize = Len(DEV_INFO)
  60.       Call SetupDiGetDeviceInterfaceDetail(hDev, DEV_DATA, DEV_DETAIL, ByVal lSize, &H0, DEV_INFO)
  61.       If UBound(Split(DEV_DETAIL.strDevicePath, "#")) > 1 Then
  62.         FlashSerials = FlashSerials & Split(UCase$(DEV_DETAIL.strDevicePath), "#")(2) & Chr$(&HD)
  63.       End If
  64.       lCount = lCount + 1
  65.     Wend
  66.  
  67.     Call SetupDiDestroyDeviceInfoList(hDev)
  68.  
  69. End Function
  70.  
  71.  
3  Programación / Programación Visual Basic / IsWay en: 22 Mayo 2011, 00:08 am


Código:

Option Explicit

'Author: Sergio Desanti
'Proved: XP (32 BIT)

Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

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

Private Type PROCESSENTRY32
    dwSize As Long: cntUsage As Long: th32ProcessID As Long: th32DefaultHeapID As Long: th32ModuleID As Long: cntThreads As Long: th32ParentProcessID As Long: pcPriClassBase As Long: dwFlags As Long: szExeFile As String * 260
End Type

Private Sub Form_Load()
    
    Shell "calc"
    Shell "calc"
    
    MsgBox IsWay("caLc.Exe")

End Sub

Private Function IsWay(ByVal NombreDelProceso As String) As String
  
  Dim Handle_Procesos As Long
  Handle_Procesos = CreateToolhelp32Snapshot(&HF, 0&)
  
  Dim PE32 As PROCESSENTRY32
  PE32.dwSize = Len(PE32)

  Dim PidProc   As Long
  Dim NameProc  As String
  Dim RutaProc  As String
  
  Dim ret As Long
  ret = Process32First(Handle_Procesos, PE32)
   
  While ret > 0
    
      NameProc = Split(PE32.szExeFile, Chr$(0))(0)
    
      If LCase$(NameProc) = LCase$(NombreDelProceso) Then
      
          PidProc = PE32.th32ProcessID
      
          Dim H_Proceso As Long
          H_Proceso = OpenProcess(&H410, &H0, PidProc)
    
          Dim Buffer As String * &H104
    
          Call GetModuleFileNameExA(H_Proceso, &H0, Buffer, &H104)
          Call CloseHandle(H_Proceso)
    
          RutaProc = Split(Buffer, Chr$(0))(0)
      
          IsWay = IsWay & vbNewLine & RutaProc & vbTab & PidProc
    
      End If
    
      ret = Process32Next(Handle_Procesos, PE32)
  
  Wend
  
  Call CloseHandle(Handle_Procesos)

  If IsWay = "" Then IsWay = "No esta Corriendo"
 
End Function
4  Programación / Programación Visual Basic / Detectar Unidades USB (Pendrive) (SRC) en: 20 Abril 2009, 23:11 pm
Hay varios codes que hacen lo mismo, pero todos los que encontré usan Hook (me resisto a usarlos)
Solo un Timer1 en el Form

NOTA 1: en el momento que el If del timer1 devuelve el string con la letra de la unidad  detectada ya se puede "operar"

NOTA 2: este code no incluye a los disquetes, ya que el for de la Function UnidadesUSB empiza desde 2 hasta 25 (cero y uno corresponden tambien a unidades extribles pero el sistema los reserva para las disqueteras)

Código:
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Option Explicit ' Hassed (http://foro.elhacker.net/programacion_vb-b50.0/)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim ControlUnidadesUSB1 As String: Dim ControlUnidadesUSB2 As String

Private Sub Form_Load()
  Timer1.Interval = 50: Me.AutoRedraw = True: Me.FontBold = True
End Sub

Private Function UnidadesUSB() As String
  Dim DiscosLogicos As Long: DiscosLogicos = GetLogicalDrives: Dim i As Long
  For i = 2 To 25
    If (DiscosLogicos And 2 ^ i) <> 0 Then
      If GetDriveType(Chr$(65 + i) + ":") = 2 Then
        UnidadesUSB = UnidadesUSB + Chr$(65 + i)
      End If
    End If
  Next i
End Function

Private Sub Timer1_Timer()
  ControlUnidadesUSB1 = UnidadesUSB
  If ControlUnidadesUSB1 <> ControlUnidadesUSB2 Then
    If Len(ControlUnidadesUSB1) > Len(ControlUnidadesUSB2) Then
      Dim i As Integer
      For i = 1 To Len(ControlUnidadesUSB1)
        If InStr(ControlUnidadesUSB2, Mid(ControlUnidadesUSB1, i, 1)) = 0 Then Me.Print Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
      Next i
    End If
    ControlUnidadesUSB2 = UnidadesUSB
  End If
End Sub



NOTA 3: el mismo code pero un poco mas completo



Código:
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Option Explicit ' Hassed (http://foro.elhacker.net/programacion_vb-b50.0/)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim ControlUnidadesUSB1 As String: Dim ControlUnidadesUSB2 As String

Private Sub Form_Load()
  If App.PrevInstance = True Then End
  ControlUnidadesUSB2 = "$"
  Me.AutoRedraw = True
  Me.FontBold = True
  Timer1.Interval = 50
End Sub
Private Function UnidadesUSB() As String
  Dim LDs As Long:  LDs = GetLogicalDrives
  Dim Cnt As Long: Dim sDrives As String
  For Cnt = 2 To 25
    If (LDs And 2 ^ Cnt) <> 0 Then
      If GetDriveType(Chr$(65 + Cnt) + ":") = 2 Then
        sDrives = sDrives + Chr$(65 + Cnt)
      End If
    End If
  Next Cnt
  UnidadesUSB = Replace(Replace(sDrives, " ", ""), ":", "")
End Function

Private Sub Timer1_Timer()
  If UnidadesUSB <> "" Then Me.Caption = "Unidades USB: " + UnidadesUSB
  If UnidadesUSB = "" Then Me.Caption = "No hay Unidades USB conectadas"
  ControlUnidadesUSB1 = UnidadesUSB
  If ControlUnidadesUSB1 <> ControlUnidadesUSB2 Then
      Dim i As Integer
      If Len(ControlUnidadesUSB1) > 0 Then
          If Len(ControlUnidadesUSB1) > Len(ControlUnidadesUSB2) Then
              For i = 1 To Len(ControlUnidadesUSB1)
                  If InStr(ControlUnidadesUSB2, Mid(ControlUnidadesUSB1, i, 1)) = 0 Then Me.Print "CONECCIÓN" + vbTab + Mid(ControlUnidadesUSB1, i, 1) + vbTab & Time
              Next i
              ControlUnidadesUSB2 = UnidadesUSB
          Else
              If ControlUnidadesUSB2 = "$" Then
                  Me.Print "CONECCIÓN" + vbTab + UnidadesUSB + vbTab & Time
                  ControlUnidadesUSB2 = UnidadesUSB
              Else
                  For i = 1 To Len(ControlUnidadesUSB2)
                      If InStr(ControlUnidadesUSB1, Mid(ControlUnidadesUSB2, i, 1)) = 0 Then Me.Print "EXPULCIÓN" + vbTab + Mid(ControlUnidadesUSB2, i, 1) + vbTab & Time
                  Next i
                  ControlUnidadesUSB2 = UnidadesUSB
              End If
          End If
      Else
          If Len(ControlUnidadesUSB1) < Len(ControlUnidadesUSB2) And ControlUnidadesUSB2 <> "$" Then
              Me.Print "EXPULCIÓN" + vbTab + ControlUnidadesUSB2 + vbTab & Time
              ControlUnidadesUSB2 = "$"
          Else
              Me.Print "SIN  DATOS" + vbTab + "···" + vbTab & Time
              ControlUnidadesUSB2 = UnidadesUSB
          End If
      End If
  End If
End Sub



NOTA 4: Saludos
Páginas: [1]
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines