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
muy bien,pero yo estoy borracho o ya hubo un post de esto... :)
Alguien lo pidio en otro post, pues ya que lo he hecho y lo e limpiado lo publico de nuevo.
Gracias por el aporte estaba buscando esto, gracias denuevo.
se agradese el aporte...
(pense lo mismo que seba123neo pero despues lei mas abajo y entendi)
:laugh:
Buenas.. buscando para hacer autoinfeccion por usb encontre este excelente code...
pero tengo un problemita.. me lo detecta todo bien al disco extraible pero me lo detecta apenas es enchufado y por lo tanto no esta listo aun para copiar ningun archivo... asi llegando a mi duda.. como hago para que detecte automaticamente cuando ya esta listo para ser guardado el archivo?
Saludos!
PD: ya se que es un tema viejo..
con api's tambien podes saber cuando una unidad esta lista si no me equivoco...
Cita de: seba123neo en 11 Noviembre 2008, 23:28 PM
con api's tambien podes saber cuando una unidad esta lista si no me equivoco...
Con APIs?... pues si, pero no como modo hook! =P
Cita de: ricardovinzo en 12 Noviembre 2008, 04:34 AM
Cita de: seba123neo en 11 Noviembre 2008, 23:28 PM
con api's tambien podes saber cuando una unidad esta lista si no me equivoco...
Con APIs?... pues si, pero no como modo hook! =P
Podrian hacerme el favor de decirme cuales apis usar para tal fin?
Saludos!
No sería más fácil hacer...
If Dir(C) = "" Then
MsgBox "Existe"
else
MsgBox "No existe"
End IF
Asi con diferentes letras ! x'dd
pero lo que yo digo es que detecte por ejemplo si tiene un cd la lectora o no...en tu caso siempre pondria que existe.. existe pero no esta lista...con la constante
Public Const IOCTL_STORAGE_CHECK_VERIFY As Long = &H2D4800
y la api DeviceIoControl , podes comprobar la disponibilidad de la unidad...podes buscar sobre eso...que en internet hay ejemplos ya realizados de lo que digo...
saludos
Public Function IsDriveReady(ByVal sDrive As String) As Boolean
sDrive = Left(sDrive, 1) & ":\"
IsDriveReady = GetVolumeInformation(sDrive, vbNullString, _
0, 0, 0, 0, vbNullString, 0)
End Function
Cita de: cobein en 13 Noviembre 2008, 04:37 AM
Public Function IsDriveReady(ByVal sDrive As String) As Boolean
sDrive = Left(sDrive, 1) & ":\"
IsDriveReady = GetVolumeInformation(sDrive, vbNullString, _
0, 0, 0, 0, vbNullString, 0)
End Function
Muchas gracias cobein y a los demas tambien =) pero me ha servido esta ultima respuesta...
dejo la declaracion de la api..
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As LongSaludos!
hi. gracias por los aportes ..tengo una pregunta hice mi aplicacion la cosas que que cuando inserto el pendrive me muestre un mensaje si quiero que el windows lo reconozca o no.. algo asi me dejo entender? si le doy "SI" que siga con lo demas y que me muestre en mi pc el dispositovo , si lo doy NO que se plante ahi y que no lo reconozca nada entiendes?? bueno ojala que puedan ayudar . gracias