Mensajes

If fecha >= bum Then


If fecha > (bum - 1) Then


If Not (fecha > (bum - 1)) Then
End
Else...

Nada, leí mal y me equivoqué en una respuesta, pero ya está editado. xD

mmm... me parece q me fuí al carajo 

Si , creo que tambien funciona con UAC activado (tal vez alguien que lo pueda probar en W7 nos informe de esto)

Un ejemplo de Hook de lo mas de lo mas simple, si te sirve... te toca optimizar y adaptar a lo tuyo.



MODULO

Código [Seleccionar] Expandir



Option Explicit

'Function: FlashSerials
'Autor   : Sergio Desanti (Hasseds)
'Thank   : Seba , Cobein, A.Desanti
'Test    : XP (32 BIT) - W7 (32 BIT)
'Return  : Serial(ESN) de Pen-Drives conectados
'

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
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

Private Const GWL_WNDPROC = -4
Private Const WM_DEVICECHANGE As Long = 537              'Cambios en un dispositivo
Private Const DBT_DEVICEARRIVAL As Long = 32768          'Cuando se conecta uno nuevo
Private Const DBT_DEVICEREMOVECOMPLETE As Long = 32772   'Cuando se desconecta uno
Private Const DBT_DEVTYP_VOLUME As Integer = 2           'Logical volume, cualquier unidad de almacenamiento nueva.

Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
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
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
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
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long

Private Type GUID
  Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(7) As Byte
End Type

Private Type SP_DEVICE_INTERFACE_DATA
  cbSize As Long: InterfaceClassGuid As GUID: flags As Long: Reserved As Long
End Type

Private Type SP_DEVICE_INTERFACE_DETAIL_DATA
  cbSize As Long: strDevicePath As String * 260
End Type

Dim hHook As Long

Public Sub StartHook(hWnd As Long)
   hHook = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub StopHook(hWnd As Long)
   SetWindowLong hWnd, GWL_WNDPROC, hHook
   hHook = 0
End Sub

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   WindowProc = CallWindowProc(hHook, hWnd, uMsg, wParam, lParam)
   If uMsg = WM_DEVICECHANGE Then
     If wParam = DBT_DEVICEARRIVAL Then
       Form1.Cls
       Form1.Print "Conectaron", Time
       Form1.Print
       Form1.Print FlashSerials
     ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then
       Form1.Cls
       Form1.Print "Desconectaron", Time
       Form1.Print
       Form1.Print FlashSerials
     End If
   End If
End Function

Public Function FlashSerials() As String

  Dim TGUID As GUID

  Call IIDFromString(StrPtr("{a5dcbf10-6530-11d2-901f-00c04fb951ed}"), TGUID)

  Dim hDev As Long
  hDev = SetupDiGetClassDevs(TGUID, &H0, &H0, &H12)
  If hDev = -1 Then Exit Function

  Dim lCount       As Long
  Dim lSize        As Long
  Dim DTL          As SP_DEVICE_INTERFACE_DETAIL_DATA
  Dim DTA          As SP_DEVICE_INTERFACE_DATA

  DTA.cbSize = Len(DTA)
  DTL.cbSize = &H5

  While Not (SetupDiEnumDeviceInterfaces(hDev, &H0, TGUID, lCount, DTA) = &H0)
    Call SetupDiGetDeviceInterfaceDetail(hDev, DTA, ByVal &H0, &H0, lSize, ByVal &H0)
    Call SetupDiGetDeviceInterfaceDetail(hDev, DTA, DTL, ByVal lSize, &H0, ByVal &H0)
    If UBound(Split(DTL.strDevicePath, "#")) > 1 Then
      FlashSerials = FlashSerials & Split(UCase$(DTL.strDevicePath), "#")(2) & Chr$(&HD)
    End If
    lCount = lCount + 1
  Wend

  Call SetupDiDestroyDeviceInfoList(hDev)
 
  If FlashSerials = "" Then FlashSerials = "No hay conexiones"
 
End Function





FORM

Código [Seleccionar] Expandir



Option Explicit

Private Sub Form_Load()
AutoRedraw = True
Print FlashSerials
Call SetWindowPos(Form1.hWnd, &HFFFF, &H0, &H0, &H0, &H0, &H3) 'form on top
Call StartHook(hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call StopHook(hWnd)
End Sub






http://www.virustotal.com/file-scan/report.html?id=4e03da8a806215953259ea3291bc79d7cab8226fdabb14765efdd81b4b94eae1-1317934469

Si ya habia visto ese code y otro similar, Una pregunta Maurice_Lupin (o el que pueda ayudar), como podria usar ese code en XP, modo Usuario o Invitado.

[Solo una acotación]

Hola, Todo se puede crackear... pero al menos deberás complicarlo lo mas posible, no solo llamando a la funcion que te devuelve el serial al principio del programa sinó varias veces en el codigo (y requiriendo distintas partes del serial, para que el retorno no sea una "variable-constante",   especialmente cuando llamas a cada una de las funciones de tu progama ,,,  tambien combinar esto con otras "cosillas" que se te vayan ocurriendo....

Solo una acotación, si el código que utilizas para obtener el serial del disco duro es con el API GetVolumeInformation ... dicho serial no es el real, solo es un serial de  "formateo" (por llamarlo de alguna manera) dicho serial es otorgado por el S.O (no por el fabricante) obviamente que cambia si el usuario de tu aplicación formatea y quiere suguir usando el mismo ejecutable.

Con WMI (Win32_DiskDrive) tengo entendido que para discos Duros...este dato  es opcional del fabricante, al margen que por ejemplo en W7 con UAC activado... WMI no está disponible ( por favor corrijan si me equivoco )

Saludos

 
App.Path & "\base.udl"

Hola, para saber el estado de un Option o un Check se puede usar el mensaje  BM_GETCHECK.


ButtonEstado = SendMessage(hwndDelButton, BM_GETCHECK, &H0, &H0)


http://winapi.conclase.net/curso/?winmsg=BM_GETCHECK#inicio


Saludos

De Nadas, usa stopHook para terminar la búsqueda y capturar las coordenadas

Código [Seleccionar] Expandir



   If Not GetPixel(lDC, lParam.x, lParam.y) = &HAA431B Then
       Form1.Caption = ""
   Else
       Form1.Caption = "AA431B " & lParam.x & " " & lParam.y
       StopHook
       Exit Function 'si hace falta
   End If



Si podés usá WindowfromPoint para que solo actúe sobre el control o la ventana que corresponda y  si tenés q cerrar la aplicación desde el code ... Unload Me o cerrar desde la "X" (BOTON CERRAR), saludos

mmm... revisá si esto  puede servir, en caso q sirva... te toca optimizar.

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Sub Form_Load()
 Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1)
 AutoRedraw = True
 FontBold = True
 BackColor = &HAA431B
 ForeColor = vbWhite
 StartHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
 StopHook
End Sub



Código (vb) [Seleccionar] Expandir



Option Explicit

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
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
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

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Const WH_MOUSE_LL As Long = 14

Private Type POINTAPI: x As Long: y As Long: End Type

Dim hHook As Long
Dim lDC As Long

Public Sub StartHook()
   hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, &H0&)
   lDC = GetWindowDC(&H0&)
End Sub


Public Sub StopHook()
   Call UnhookWindowsHookEx(hHook)
   hHook = &H0&
   Call ReleaseDC(&H0&, lDC)
End Sub


Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long
   
   Dim lColor As Long
   lColor = GetPixel(lDC, lParam.x, lParam.y)
   
   'If Not lColor < 0 Then
     'Form1.Cls
     'Form1.Print Hex(lColor)
     If lColor = &HAA431B Then
       Form1.Caption = "SI"
     Else
       Form1.Caption = "NO"
     End If
   'End If
 
 MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam)

End Function