Mensajes

No lo he probado pero me canso de ver programas iguales... supongo que es como un binder que extrae el bat y lo ejecuta.
Podias ser un poco mas original y usar un codigo como este, con pipes, y acer un bucle e ir escribiendo en una consola de verdad linea por linea todos los comandos...
http://foro.elhacker.net/programacion_vb/simulacion_de_consola_en_vb-t216497.0.html

No se que tienes en tu ordenador. Yo uso windows XP y cuando lo ejecuto primero me dice windows que es potencialmente peligroso. Despues el antivirus intenta eliminarlo y le doy a que no, después me dice que algunas instruciones son peligrosas y me pregunta otra vez y finalmente se ejecuta....

vbs esta muerto, te aparecen en la pantalla 10 mensajes antes de k se ejecute si llega xD

Porque tanto lio, en vb es una linea de código que hace lo mismo que hacéis vosotros..

Código [Seleccionar] Expandir


Shell "C:\WINDOWS\NOTEPAD.EXE", vbHide


El DoEvents no es el problema, le problema esta en que no se cumplen las condiciones para salir de el bucle y se convierte en un proceso infinito.
El DoEvents solo se utiliza dentro de los bucles para consumir menos cantidad de recursos del sistema, es como una pausa muy pequeña.

Alguien lo pidio en otro post, pues ya que lo he hecho y lo e limpiado lo publico de nuevo.

Formulario:

Código [Seleccionar] Expandir


'Programado por Kizar
Private Sub Form_Load()
    AllLocalDrives
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub


Modulo:

Código [Seleccionar] Expandir

'Programado por Kizar
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Declare Function GetLogicalDrives Lib "kernel32" () As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Type DEV_BROADCAST_HDR
    dbch_size As Long
    dbch_devicetype As Long
    dbch_reserved As Long
End Type

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

Dim PrevProc As Long
Dim lArray() As String

Public Sub HookForm(hwnd As Long)
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookForm(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = WM_DEVICECHANGE Then
        If wParam = DBT_DEVICEARRIVAL Then
            Dim dev As DEV_BROADCAST_HDR
            CopyMemory dev, ByVal lParam, 12
            If dev.dbch_devicetype = DBT_DEVTYP_VOLUME Then
                MsgBox USBConected
            End If
        ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then
            AllLocalDrives
        End If
    End If
End Function

Public Function USBConected() As String
    Dim hVolume As Long, i As Integer, b As Integer, find As Boolean
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 Then
            For b = 0 To UBound(lArray)
                If lArray(b) = Chr(i + 65) Then find = True: Exit For
            Next b
            If find = False Then
                ReDim Preserve lArray(UBound(lArray) + 1)
                lArray(UBound(lArray)) = Chr(i + 65)
                USBConected = Chr(i + 65) & ":"
                Exit Function
            End If
        End If
        find = False
    Next i
End Function

Public Sub AllLocalDrives()
    Dim hVolume As Long, count As Integer, i As Integer
    Erase lArray
    count = 0
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 Then
            ReDim Preserve lArray(count)
            lArray(count) = Chr(i + 65)
            count = count + 1
        End If
    Next i
End Sub

Lo de detectarlos por el tipo de Bus te lo dejo a ti que yo no tengo mucho tiempo hoy.

Formulario:

Código [Seleccionar] Expandir


Private Sub Form_Load()
    LocalDrives
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub


Modulo:

Código [Seleccionar] Expandir

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Declare Function GetLogicalDrives Lib "kernel32" () As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Type DEV_BROADCAST_HDR
    dbch_size As Long
    dbch_devicetype As Long
    dbch_reserved As Long
End Type

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

Dim PrevProc As Long
Dim lArray() As String

Public Sub HookForm(hwnd As Long)
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookForm(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = WM_DEVICECHANGE Then
        If wParam = DBT_DEVICEARRIVAL Then
            Dim dev As DEV_BROADCAST_HDR
            CopyMemory dev, ByVal lParam, 12
            If dev.dbch_devicetype = DBT_DEVTYP_VOLUME Then
                'Mostramos la letra de la ultima unidad de almacenamiento conectada
                MsgBox USBConected
            End If
        ElseIf wParam = DBT_DEVICEREMOVECOMPLETE Then
            'Si se desconecta alguno volvemos ha hacer toda la lista.
            LocalDrives
        End If
    End If
End Function

Public Function USBConected() As String
    Dim hVolume As Long, i As Integer, b As Integer, find As Boolean
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 Then
            For b = 0 To UBound(lArray)
                If lArray(b) = Chr(i + 65) Then find = True: Exit For
            Next b
            If find = False Then
                ReDim Preserve lArray(UBound(lArray) + 1)
                lArray(UBound(lArray)) = Chr(i + 65)
                USBConected = Chr(i + 65) & ":"
                Exit Function
            End If
        End If
        find = False
    Next i
End Function

Public Sub LocalDrives()
    Dim hVolume As Long, count As Integer, i As Integer
    Erase lArray
    count = 0
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 Then
            ReDim Preserve lArray(count)
            lArray(count) = Chr(i + 65)
            count = count + 1
        End If
    Next i
End Sub

Primero la manera correcta de hacerlo seria copiar la estructura que pasa lParam para ver que tipo de dispositivo es etc.

Si, eso seria lo correcto, esta tarde si tengo tiempo lo cambio.

Segundo, este code se dispara de manera herrada por ejemplo al montar un volumen.

Si cambio lo anterior esto no pasa.

La funcion de "escaneo" de drives tendria que iniciarce y luego al reescanear hacer una comparacion, de la manera en que esta hecho ahora simplemente va a reportar la primer unidad que sea removible (DRIVE_REMOVABLE).

Tal y como esta ahora te muestra el ultimo pendrive conectado. Windows asigna letras en orden alfabetico a los nuevos dispositivos, pro lo tanto si encuentro dos pendrives uno llamado H: y otro I:
USBConected valdrá primero H:
Después USBConected valdra I:
Y después saldrá del for y devolverá el valor I:
Esto seria lo normal que ocurriese, ya se que puede que desconectes primero el H: y  a la proxima vez el proximo dispositivo sea H: pero esto pasa pocas veces...Se puede solucionar con una pequeña matriz pero así queda mas elegante xD

Y por ultimo, esa funcion no es correcta puesto que hay memorias y/o discos que no son reconocidos como DRIVE_REMOVABLE, para identificarlos tendrias que ver que el tipo de bus sea BusTypeUsb

A mi nunca me paso eso, siempre con DRIVE_REMOVABLE me ha devuelto bien las unidades Flash.

Lo acabo de hacer por aburrimiento, a partir de aquí es fácil hacer un pequeño virus...
Cuando se conecta un dispositivo se llama a la función USBConected y esta te devuelve la letra de el ultimo pendrive conectado.

Formulario:

Código [Seleccionar] Expandir


Private Sub Form_Load()
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub


Modulo (bas):

Código [Seleccionar] Expandir


Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 GetLogicalDrives Lib "kernel32" () As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Const GWL_WNDPROC = -4
Public Const WM_DEVICECHANGE As Long = 537              'Cambios en un dispositivo
Public Const DBT_DEVICEARRIVAL As Long = 32768          'Cuando se conecta uno nuevo
Public Const DBT_DEVICEREMOVECOMPLETE As Long = 32772   'Cuando se desconecta uno
Public Const DRIVE_REMOVABLE As Integer = 2
Dim PrevProc As Long

Public Sub HookForm(hwnd As Long)
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookForm(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    If uMsg = WM_DEVICECHANGE And wParam = DBT_DEVICEARRIVAL Then
        MsgBox USBConected
    End If
End Function

Public Function USBConected() As String
    Dim hVolume As Long, i As Integer
    hVolume = GetLogicalDrives()
    For i = 0 To 25
        If (hVolume And 2 ^ i) <> 0 And GetDriveType(Chr(i + 65) & ":") = DRIVE_REMOVABLE Then
            USBConected = Chr(i + 65) & ":"
        End If
    Next
End Function