|
12
|
Programación / Programación Visual Basic / Re: Ejecutar de modo oculto .bats, exes ,etc
|
en: 5 Junio 2008, 22:23 pm
|
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....
|
|
|
15
|
Programación / Programación Visual Basic / Re: DoEvents se cuelga!
|
en: 4 Junio 2008, 20:44 pm
|
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.
|
|
|
17
|
Programación / Programación Visual Basic / (Source) Detectar unidades extraibles USB
|
en: 31 Mayo 2008, 16:53 pm
|
Formulario: '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: '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
|
|
|
18
|
Programación / Programación Visual Basic / Re: Detectar USB, Pendrives
|
en: 30 Mayo 2008, 16:45 pm
|
Lo de detectarlos por el tipo de Bus te lo dejo a ti que yo no tengo mucho tiempo hoy. Formulario: Private Sub Form_Load() LocalDrives HookForm Me.hwnd End Sub
Private Sub Form_Unload(Cancel As Integer) UnHookForm Me.hwnd End Sub
Modulo: 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
|
|
|
19
|
Programación / Programación Visual Basic / Re: Detectar USB, Pendrives
|
en: 30 Mayo 2008, 08:54 am
|
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.
|
|
|
20
|
Programación / Programación Visual Basic / Re: Detectar USB, Pendrives
|
en: 30 Mayo 2008, 01:09 am
|
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: Private Sub Form_Load() HookForm Me.hwnd End Sub
Private Sub Form_Unload(Cancel As Integer) UnHookForm Me.hwnd End Sub
Modulo (bas): 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
|
|
|
|
|
|
|