Darleck
21-07-2010, 19:42
Codigo:
Private Sub Form_Load()
AllLocalDrives
HookForm Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me.hwnd
End Sub
Private Sub Command1_Click()
seg = Text1.Text & "clave.txt"
If seg <> "" Then
MsgBox "Si hay clave", vbInformation, "Seguridad"
Else
MsgBox "No hay clave", vbInformation, "Seguridad"
End If
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
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) & ": lokazo"
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 q necesito es q la letra de la nueva unidad montada se muestre en el text1.text para q luego buske un determinado archivo ejemplo clave.txt dentro del usb.. agradeceria q me ayudaran apenas lo tengo terminado posteare el codigo para q uds. me digan q opinan o si creen q deberia arreglar o mejorar algo. Gracias.
Private Sub Form_Load()
AllLocalDrives
HookForm Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me.hwnd
End Sub
Private Sub Command1_Click()
seg = Text1.Text & "clave.txt"
If seg <> "" Then
MsgBox "Si hay clave", vbInformation, "Seguridad"
Else
MsgBox "No hay clave", vbInformation, "Seguridad"
End If
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
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) & ": lokazo"
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 q necesito es q la letra de la nueva unidad montada se muestre en el text1.text para q luego buske un determinado archivo ejemplo clave.txt dentro del usb.. agradeceria q me ayudaran apenas lo tengo terminado posteare el codigo para q uds. me digan q opinan o si creen q deberia arreglar o mejorar algo. Gracias.