elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.


Tema destacado: Estamos en la red social de Mastodon


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Controlar el uso de memorias USB		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 Ir Abajo Respuesta Imprimir
Autor Tema: Controlar el uso de memorias USB  (Leído 6,805 veces)
josp24

Desconectado Desconectado

Mensajes: 9


Ver Perfil
Controlar el uso de memorias USB
« en: 30 Junio 2008, 22:43 pm »
Hola, para mi proyecto de residencia profesional me pidieron que realizara un software en Visual Basic 6 que pudiera restringir el uso de memorias USB solo para personal autorizado. Es decir, que cuando alguien introduzca una memoria USB a una PC le pida nombre de usuario y contraseña para que pueda utilizarla (leer y escribir en ella), si no rechazarla automáticamente. Ojala y alguien pudiera ayudarme ya que estado buscando y no encuentro nada que me pueda servir. De antemano muchas gracias.
En línea
aaronduran2


Desconectado Desconectado

Mensajes: 790



Ver Perfil WWW
Re: Controlar el uso de memorias USB
« Respuesta #1 en: 30 Junio 2008, 22:55 pm »
La siguiente clase permite detectar la introducción/extracción de unidades USB. De ese modo, podrías hacer que:

- El programa está cargado.
- Introduces la unidad USB.
- El programa la detecta y pregunta por el usuario y la contraseña.
- Si son correctos continúa, en caso contrario bloquea la unidad (la forma de hacerlo a tu elección)

Está dividida en dos debido al tamaño máximo de los post.

Créditos a Cobein.
Código
  1. '---------------------------------------------------------------------------------------
  2. ' Module      : cUSB_Detection
  3. ' DateTime    : 19/06/2008 18:17
  4. ' Author      : Cobein
  5. ' Mail        : cobein27@hotmail.com
  6. ' WebPage     : http://cobein27.googlepages.com/vb6
  7. ' Purpose     : Simple USB device detection
  8. ' Usage       : At your own risk
  9. ' Requirements: None
  10. ' Distribution: You can freely use this code in your own
  11. '               applications, but you may not reproduce
  12. '               or publish this code on any web site,
  13. '               online service, or distribute as source
  14. '               on any media without express permission.
  15. '
  16. ' Reference   : http://msdn.microsoft.com/en-us/library/aa363205(VS.85).aspx
  17. '
  18. ' TODO        : Expand capabilities to support all WM_DEVICECHANGE message params and types
  19. '
  20. ' Important   : The class is pre-filtering drives by bustype = USB
  21. '
  22. ' History     : 19/06/2008 First Cut....................................................
  23. '---------------------------------------------------------------------------------------
  24. Option Explicit
  25.  
  26. Private Const IDX_INDEX             As Long = 2     'index of the subclassed hWnd OR hook type
  27. Private Const IDX_CALLBACKORDINAL   As Long = 22    ' Ubound(callback thunkdata)+1, index of the callback
  28.  
  29. Private Const IDX_WNDPROC           As Long = 9     'Thunk data index of the original WndProc
  30. Private Const IDX_BTABLE            As Long = 11    'Thunk data index of the Before table
  31. Private Const IDX_ATABLE            As Long = 12    'Thunk data index of the After table
  32. Private Const IDX_PARM_USER         As Long = 13    'Thunk data index of the User-defined callback parameter data index
  33. Private Const IDX_UNICODE           As Long = 75    'Must be Ubound(subclass thunkdata)+1; index for unicode support
  34. Private Const ALL_MESSAGES          As Long = -1    'All messages callback
  35. Private Const MSG_ENTRIES           As Long = 32    'Number of msg table entries. Set to 1 if using ALL_MESSAGES for all subclassed windows
  36.  
  37. Private Const IOCTL_STORAGE_BASE    As Long = &H2D
  38. Private Const METHOD_BUFFERED       As Long = 0
  39. Private Const FILE_ANY_ACCESS       As Long = 0
  40. Private Const GENERIC_READ          As Long = &H80000000
  41. Private Const FILE_SHARE_READ       As Long = &H1
  42. Private Const OPEN_EXISTING         As Long = 3
  43. Private Const FILE_SHARE_WRITE      As Long = &H2
  44. Private Const INVALID_HANDLE_VALUE  As Long = (-1)
  45.  
  46. Private Const WM_DEVICECHANGE       As Long = &H219
  47. Private Const DBT_DEVICEARRIVAL     As Long = &H8000&
  48. Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
  49. Private Const DBT_DEVTYP_VOLUME     As Long = &H2
  50. Private Const DBTF_MEDIA            As Long = &H1
  51.  
  52. Private Enum eThunkType
  53.     SubclassThunk = 0
  54.     HookThunk = 1
  55.     CallbackThunk = 2
  56. End Enum
  57.  
  58. Private Enum eMsgWhen
  59.     MSG_BEFORE = 1
  60.     MSG_AFTER = 2
  61.     MSG_BEFORE_AFTER = MSG_BEFORE Or MSG_AFTER
  62. End Enum
  63.  
  64. Enum eDriveType
  65.     DRIVE_UNKNOWN
  66.     DRIVE_NO_ROOT_DIR
  67.     DRIVE_REMOVABLE
  68.     DRIVE_FIXED
  69.     DRIVE_REMOTE
  70.     DRIVE_CDROM
  71.     DRIVE_RAMDISK
  72. End Enum
  73.  
  74. Private Enum STORAGE_PROPERTY_ID
  75.     StorageDeviceProperty = 0
  76.     StorageAdapterProperty
  77. End Enum
  78.  
  79. Private Enum STORAGE_QUERY_TYPE
  80.     PropertyStandardQuery = 0
  81.     PropertyExistsQuery
  82.     PropertyMaskQuery
  83.     PropertyQueryMaxDefined
  84. End Enum
  85.  
  86. Enum STORAGE_BUS_TYPE
  87.     BusTypeUnknown = 0
  88.     BusTypeScsi
  89.     BusTypeAtapi
  90.     BusTypeAta
  91.     BusType1394
  92.     BusTypeSsa
  93.     BusTypeFibre
  94.     BusTypeUsb
  95.     BusTypeRAID
  96.     BusTypeMaxReserved = &H7F
  97. End Enum
  98.  
  99. Private Type DEV_BROADCAST_HDR
  100.     dbch_size                       As Long
  101.     dbch_devicetype                 As Long
  102.     dbch_reserved                   As Long
  103. End Type
  104.  
  105. Private Type DEV_BROADCAST_VOLUME
  106.    dbcv_size                        As Long
  107.    dbcv_devicetype                  As Long
  108.    dbcv_reserved                    As Long
  109.    dbcv_unitmask                    As Long
  110.    dbcv_flags                       As Integer
  111. End Type
  112.  
  113. Private Type STORAGE_PROPERTY_QUERY
  114.     PropertyId                      As STORAGE_PROPERTY_ID
  115.     QueryType                       As STORAGE_QUERY_TYPE
  116.     AdditionalParameters(0)         As Byte
  117. End Type
  118.  
  119. Private Type OVERLAPPED
  120.     Internal                        As Long
  121.     InternalHigh                    As Long
  122.     offset                          As Long
  123.     OffsetHigh                      As Long
  124.     hEvent                          As Long
  125. End Type
  126.  
  127. Private Type STORAGE_DEVICE_DESCRIPTOR
  128.     Version                         As Long
  129.     Size                            As Long
  130.     DeviceType                      As Byte
  131.     DeviceTypeModifier              As Byte
  132.     RemovableMedia                  As Byte
  133.     CommandQueueing                 As Byte
  134.     VendorIdOffset                  As Long
  135.     ProductIdOffset                 As Long
  136.     ProductRevisionOffset           As Long
  137.     SerialNumberOffset              As Long
  138.     BusType                         As STORAGE_BUS_TYPE
  139.     RawPropertiesLength             As Long
  140.     RawDeviceProperties(0)          As Byte
  141. End Type
  142.  
  143. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  144. Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
  145. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  146. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  147. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  148. Private Declare Function GetModuleHandleW Lib "kernel32" (ByVal lpModuleName As Long) As Long
  149. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  150. Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  151. Private Declare Function CallWindowProcW Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  152. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  153. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  154. Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
  155. Private Declare Function IsWindowUnicode Lib "user32.dll" (ByVal hwnd As Long) As Long
  156. Private Declare Function SendMessageA Lib "user32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  157. Private Declare Function SendMessageW Lib "user32.dll" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  158. Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  159. Private Declare Function SetWindowLongW Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  160. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
  161. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  162. Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
  163. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  164. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  165. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  166. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  167.  
  168. Private c_lhWnd                     As Long
  169. Private z_IDEflag                   As Long         'Flag indicating we are in IDE
  170. Private z_ScMem                     As Long         'Thunk base address
  171. Private z_scFunk                    As Collection   'hWnd/thunk-address collection
  172. Private z_hkFunk                    As Collection   'hook/thunk-address collection
  173. Private z_cbFunk                    As Collection   'callback/thunk-address collection
  174.  
  175. Public Event DriveArrival(ByVal sDrive As String, ByVal lDriveType As eDriveType)
  176. Public Event DriveRemoval(ByVal sDrive As String)
  177.  
  178. Private Sub Class_Initialize()
  179.  
  180.     c_lhWnd = CreateWindowEx(0, "STATIC", 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
  181.  
  182.     If Not c_lhWnd = 0 Then
  183.         If ssc_Subclass(c_lhWnd, , 1) Then
  184.             Call ssc_AddMsg(c_lhWnd, WM_DEVICECHANGE, MSG_AFTER)
  185.         Else
  186.             Call DestroyWindow(c_lhWnd): c_lhWnd = 0
  187.         End If
  188.     End If
  189. End Sub
  190.  
  191. Private Sub Class_Terminate()
  192.     Call ssc_Terminate
  193.     Call DestroyWindow(c_lhWnd)
  194.     c_lhWnd = 0
  195. End Sub
  196.  
  197. '-The following routines are exclusively for the ssc_subclass routines----------------------------
  198. Private Function ssc_Subclass(ByVal lng_hWnd As Long, _
  199.        Optional ByVal lParamUser As Long = 0, _
  200.        Optional ByVal nOrdinal As Long = 1, _
  201.        Optional ByVal oCallback As Object = Nothing, _
  202.        Optional ByVal bIdeSafety As Boolean = True, _
  203.        Optional ByVal bUnicode As Boolean = False) As Boolean 'Subclass the specified window handle
  204.  
  205.     ' \\LaVolpe - reworked routine a bit, revised the ASM to allow auto-unsubclass on WM_DESTROY
  206.     Dim z_Sc(0 To IDX_UNICODE) As Long                 'Thunk machine-code initialised here
  207.     Const CODE_LEN      As Long = 4 * IDX_UNICODE      'Thunk length in bytes
  208.  
  209.     Const MEM_LEN       As Long = CODE_LEN + (8 * (MSG_ENTRIES))  'Bytes to allocate per thunk, data + code + msg tables
  210.     Const PAGE_RWX      As Long = &H40&                'Allocate executable memory
  211.     Const MEM_COMMIT    As Long = &H1000&              'Commit allocated memory
  212.     Const MEM_RELEASE   As Long = &H8000&              'Release allocated memory flag
  213.     Const IDX_EBMODE    As Long = 3                    'Thunk data index of the EbMode function address
  214.     Const IDX_CWP       As Long = 4                    'Thunk data index of the CallWindowProc function address
  215.     Const IDX_SWL       As Long = 5                    'Thunk data index of the SetWindowsLong function address
  216.     Const IDX_FREE      As Long = 6                    'Thunk data index of the VirtualFree function address
  217.     Const IDX_BADPTR    As Long = 7                    'Thunk data index of the IsBadCodePtr function address
  218.     Const IDX_OWNER     As Long = 8                    'Thunk data index of the Owner object's vTable address
  219.     Const IDX_CALLBACK  As Long = 10                   'Thunk data index of the callback method address
  220.     Const IDX_EBX       As Long = 16                   'Thunk code patch index of the thunk data
  221.     Const GWL_WNDPROC   As Long = -4                   'SetWindowsLong WndProc index
  222.     Const WNDPROC_OFF   As Long = &H38                 'Thunk offset to the WndProc execution address
  223.     Const SUB_NAME      As String = "ssc_Subclass"     'This routine's name
  224.  
  225.     Dim nAddr         As Long
  226.     Dim nID           As Long
  227.     Dim nMyID         As Long
  228.  
  229.     If IsWindow(lng_hWnd) = 0 Then                      'Ensure the window handle is valid
  230.         zError SUB_NAME, "Invalid window handle"
  231.         Exit Function
  232.     End If
  233.  
  234.     nMyID = GetCurrentProcessId                         'Get this process's ID
  235.     GetWindowThreadProcessId lng_hWnd, nID              'Get the process ID associated with the window handle
  236.     If nID <> nMyID Then                                'Ensure that the window handle doesn't belong to another process
  237.         zError SUB_NAME, "Window handle belongs to another process"
  238.         Exit Function
  239.     End If
  240.  
  241.     If oCallback Is Nothing Then Set oCallback = Me     'If the user hasn't specified the callback owner
  242.  
  243.     nAddr = zAddressOf(oCallback, nOrdinal)             'Get the address of the specified ordinal method
  244.     If nAddr = 0 Then                                   'Ensure that we've found the ordinal method
  245.         zError SUB_NAME, "Callback method not found"
  246.         Exit Function
  247.     End If
  248.  
  249.     z_ScMem = VirtualAlloc(0, MEM_LEN, MEM_COMMIT, PAGE_RWX) 'Allocate executable memory
  250.  
  251.     If z_ScMem <> 0 Then                                  'Ensure the allocation succeeded
  252.  
  253.         If z_scFunk Is Nothing Then Set z_scFunk = New Collection 'If this is the first time through, do the one-time initialization
  254.         On Error GoTo CatchDoubleSub                              'Catch double subclassing
  255.         z_scFunk.Add z_ScMem, "h" & lng_hWnd                    'Add the hWnd/thunk-address to the collection
  256.         On Error GoTo 0
  257.  
  258.         ' \\Tai Chi Minh Ralph Eastwood - fixed bug where the MSG_AFTER was not being honored
  259.         ' \\LaVolpe - modified thunks to allow auto-unsubclassing when WM_DESTROY received
  260.         z_Sc(14) = &HD231C031: z_Sc(15) = &HBBE58960: z_Sc(16) = &H12345678: z_Sc(17) = &HF63103FF: z_Sc(18) = &H750C4339: z_Sc(19) = &H7B8B4A38: z_Sc(20) = &H95E82C: z_Sc(21) = &H7D810000: z_Sc(22) = &H228&: z_Sc(23) = &HC70C7500: z_Sc(24) = &H20443: z_Sc(25) = &H5E90000: z_Sc(26) = &H39000000: z_Sc(27) = &HF751475: z_Sc(28) = &H25E8&: z_Sc(29) = &H8BD23100: z_Sc(30) = &H6CE8307B: z_Sc(31) = &HFF000000: z_Sc(32) = &H10C2610B: z_Sc(33) = &HC53FF00: z_Sc(34) = &H13D&: z_Sc(35) = &H85BE7400: z_Sc(36) = &HE82A74C0: z_Sc(37) = &H2&: z_Sc(38) = &H75FFE5EB: z_Sc(39) = &H2C75FF30: z_Sc(40) = &HFF2875FF: z_Sc(41) = &H73FF2475: z_Sc(42) = &H1053FF24: z_Sc(43) = &H811C4589: z_Sc(44) = &H13B&: z_Sc(45) = &H39727500:
  261.         z_Sc(46) = &H6D740473: z_Sc(47) = &H2473FF58: z_Sc(48) = &HFFFFFC68: z_Sc(49) = &H873FFFF: z_Sc(50) = &H891453FF: z_Sc(51) = &H7589285D: z_Sc(52) = &H3045C72C: z_Sc(53) = &H8000&: z_Sc(54) = &H8920458B: z_Sc(55) = &H4589145D: z_Sc(56) = &HC4816124: z_Sc(57) = &H4&: z_Sc(58) = &H8B1862FF: z_Sc(59) = &H853AE30F: z_Sc(60) = &H810D78C9: z_Sc(61) = &H4C7&: z_Sc(62) = &H28458B00: z_Sc(63) = &H2975AFF2: z_Sc(64) = &H2873FF52: z_Sc(65) = &H5A1C53FF: z_Sc(66) = &H438D1F75: z_Sc(67) = &H144D8D34: z_Sc(68) = &H1C458D50: z_Sc(69) = &HFF3075FF: z_Sc(70) = &H75FF2C75: z_Sc(71) = &H873FF28: z_Sc(72) = &HFF525150: z_Sc(73) = &H53FF2073: z_Sc(74) = &HC328C328
  262.  
  263.         z_Sc(IDX_EBX) = z_ScMem                                                 'Patch the thunk data address
  264.         z_Sc(IDX_INDEX) = lng_hWnd                                               'Store the window handle in the thunk data
  265.         z_Sc(IDX_BTABLE) = z_ScMem + CODE_LEN                                   'Store the address of the before table in the thunk data
  266.         z_Sc(IDX_ATABLE) = z_ScMem + CODE_LEN + ((MSG_ENTRIES + 1) * 4)         'Store the address of the after table in the thunk data
  267.         z_Sc(IDX_OWNER) = ObjPtr(oCallback)                                     'Store the callback owner's object address in the thunk data
  268.         z_Sc(IDX_CALLBACK) = nAddr                                              'Store the callback address in the thunk data
  269.         z_Sc(IDX_PARM_USER) = lParamUser                                        'Store the lParamUser callback parameter in the thunk data
  270.  
  271.         ' \\LaVolpe - validate unicode request & cache unicode usage
  272.         If bUnicode Then bUnicode = (IsWindowUnicode(lng_hWnd) <> 0&)
  273.         z_Sc(IDX_UNICODE) = bUnicode                                            'Store whether the window is using unicode calls or not
  274.  
  275.         ' \\LaVolpe - added extra parameter "bUnicode" to the zFnAddr calls
  276.         z_Sc(IDX_FREE) = zFnAddr("kernel32", "VirtualFree", bUnicode)           'Store the VirtualFree function address in the thunk data
  277.         z_Sc(IDX_BADPTR) = zFnAddr("kernel32", "IsBadCodePtr", bUnicode)        'Store the IsBadCodePtr function address in the thunk data
  278.  
  279.         Debug.Assert zInIDE
  280.         If bIdeSafety = True And z_IDEflag = 1 Then                             'If the user wants IDE protection
  281.             z_Sc(IDX_EBMODE) = zFnAddr("vba6", "EbMode", bUnicode)                'Store the EbMode function address in the thunk data
  282.         End If
  283.  
  284.         ' \\LaVolpe - use ANSI for non-unicode usage, else use WideChar calls
  285.         If bUnicode Then
  286.             z_Sc(IDX_CWP) = zFnAddr("user32", "CallWindowProcW", bUnicode)          'Store CallWindowProc function address in the thunk data
  287.             z_Sc(IDX_SWL) = zFnAddr("user32", "SetWindowLongW", bUnicode)           'Store the SetWindowLong function address in the thunk data
  288.             z_Sc(IDX_UNICODE) = 1
  289.             RtlMoveMemory z_ScMem, VarPtr(z_Sc(0)), CODE_LEN                        'Copy the thunk code/data to the allocated memory
  290.             nAddr = SetWindowLongW(lng_hWnd, GWL_WNDPROC, z_ScMem + WNDPROC_OFF)    'Set the new WndProc, return the address of the original WndProc
  291.         Else
  292.             z_Sc(IDX_CWP) = zFnAddr("user32", "CallWindowProcA", bUnicode)          'Store CallWindowProc function address in the thunk data
  293.             z_Sc(IDX_SWL) = zFnAddr("user32", "SetWindowLongA", bUnicode)           'Store the SetWindowLong function address in the thunk data
  294.             RtlMoveMemory z_ScMem, VarPtr(z_Sc(0)), CODE_LEN                        'Copy the thunk code/data to the allocated memory
  295.             nAddr = SetWindowLongA(lng_hWnd, GWL_WNDPROC, z_ScMem + WNDPROC_OFF)    'Set the new WndProc, return the address of the original WndProc
  296.         End If
  297.         If nAddr = 0 Then                                                           'Ensure the new WndProc was set correctly
  298.             zError SUB_NAME, "SetWindowLong failed, error #" & Err.LastDllError
  299.             GoTo ReleaseMemory
  300.         End If
  301.         'Store the original WndProc address in the thunk data
  302.         RtlMoveMemory z_ScMem + IDX_WNDPROC * 4, VarPtr(nAddr), 4&              ' z_Sc(IDX_WNDPROC) = nAddr
  303.         ssc_Subclass = True                                                     'Indicate success
  304.     Else
  305.         zError SUB_NAME, "VirtualAlloc failed, error: " & Err.LastDllError
  306.     End If
  307.  
  308.     Exit Function                                                             'Exit ssc_Subclass
  309.  
  310. CatchDoubleSub:
  311.     zError SUB_NAME, "Window handle is already subclassed"
  312.  
  313. ReleaseMemory:
  314.     VirtualFree z_ScMem, 0, MEM_RELEASE                                       'ssc_Subclass has failed after memory allocation, so release the memory
  315. End Function
  316.  
  317. 'Terminate all subclassing
  318. Private Sub ssc_Terminate()
  319.     ' can be made public. Releases all subclassing
  320.     ' can be removed and zTerminateThunks can be called directly
  321.     zTerminateThunks SubclassThunk
  322. End Sub
  323.  
  324. 'Add the message value to the window handle's specified callback table
  325. Private Sub ssc_AddMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  326.     ' Note: can be removed if not needed and zAddMsg can be called directly
  327.     If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then                 'Ensure that the thunk hasn't already released its memory
  328.         If When And MSG_BEFORE Then                                             'If the message is to be added to the before original WndProc table...
  329.             zAddMsg uMsg, IDX_BTABLE                                              'Add the message to the before table
  330.         End If
  331.         If When And MSG_AFTER Then                                              'If message is to be added to the after original WndProc table...
  332.             zAddMsg uMsg, IDX_ATABLE                                              'Add the message to the after table
  333.         End If
  334.     End If
  335. End Sub
  336.  
  337. 'Delete the message value from the window handle's specified callback table
  338. Private Sub ssc_DelMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  339.     ' Note: can be removed if not needed and zDelMsg can be called directly
  340.     If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then                'Ensure that the thunk hasn't already released its memory
  341.         If When And MSG_BEFORE Then                                             'If the message is to be deleted from the before original WndProc table...
  342.             zDelMsg uMsg, IDX_BTABLE                                              'Delete the message from the before table
  343.         End If
  344.         If When And MSG_AFTER Then                                              'If the message is to be deleted from the after original WndProc table...
  345.             zDelMsg uMsg, IDX_ATABLE                                              'Delete the message from the after table
  346.         End If
  347.     End If
  348. End Sub
  349.  
  350. 'Call the original WndProc
  351. Private Function ssc_CallOrigWndProc(ByVal lng_hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  352.     ' Note: can be removed if you do not use this function inside of your window procedure
  353.     If IsBadCodePtr(zMap_VFunction(lng_hWnd, SubclassThunk)) = 0 Then            'Ensure that the thunk hasn't already released its memory
  354.         If zData(IDX_UNICODE) Then
  355.             ssc_CallOrigWndProc = CallWindowProcW(zData(IDX_WNDPROC), lng_hWnd, uMsg, wParam, lParam) 'Call the original WndProc of the passed window handle parameter
  356.         Else
  357.             ssc_CallOrigWndProc = CallWindowProcA(zData(IDX_WNDPROC), lng_hWnd, uMsg, wParam, lParam) 'Call the original WndProc of the passed window handle parameter
  358.         End If
  359.     End If
  360. End Function
  361.  
  362. 'Get the subclasser lParamUser callback parameter
  363. Private Function zGet_lParamUser(ByVal hWnd_Hook_ID As Long, vType As eThunkType) As Long
  364.     'Note: can be removed if you never need to retrieve/update your user-defined paramter. See ssc_Subclass
  365.     If vType <> CallbackThunk Then
  366.         If IsBadCodePtr(zMap_VFunction(hWnd_Hook_ID, vType)) = 0 Then        'Ensure that the thunk hasn't already released its memory
  367.             zGet_lParamUser = zData(IDX_PARM_USER)                                'Get the lParamUser callback parameter
  368.         End If
  369.     End If
  370. End Function
  371.  
  372. 'Let the subclasser lParamUser callback parameter
  373. Private Sub zSet_lParamUser(ByVal hWnd_Hook_ID As Long, vType As eThunkType, newValue As Long)
  374.     'Note: can be removed if you never need to retrieve/update your user-defined paramter. See ssc_Subclass
  375.     If vType <> CallbackThunk Then
  376.         If IsBadCodePtr(zMap_VFunction(hWnd_Hook_ID, vType)) = 0 Then          'Ensure that the thunk hasn't already released its memory
  377.             zData(IDX_PARM_USER) = newValue                                         'Set the lParamUser callback parameter
  378.         End If
  379.     End If
  380. End Sub
  381.  
  382. 'Add the message to the specified table of the window handle
  383. Private Sub zAddMsg(ByVal uMsg As Long, ByVal nTable As Long)
  384.     Dim nCount As Long                                                        'Table entry count
  385.     Dim nBase  As Long                                                        'Remember z_ScMem
  386.     Dim i      As Long                                                        'Loop index
  387.  
  388.     nBase = z_ScMem                                                           'Remember z_ScMem so that we can restore its value on exit
  389.     z_ScMem = zData(nTable)                                                   'Map zData() to the specified table
  390.  
  391.     If uMsg = ALL_MESSAGES Then                                               'If ALL_MESSAGES are being added to the table...
  392.         nCount = ALL_MESSAGES                                                   'Set the table entry count to ALL_MESSAGES
  393.     Else
  394.         nCount = zData(0)                                                       'Get the current table entry count
  395.         If nCount >= MSG_ENTRIES Then                                           'Check for message table overflow
  396.             zError "zAddMsg", "Message table overflow. Either increase the value of Const MSG_ENTRIES or use ALL_MESSAGES instead of specific message values"
  397.             GoTo Bail
  398.         End If
  399.  
  400.         For i = 1 To nCount                                                     'Loop through the table entries
  401.             If zData(i) = 0 Then                                                  'If the element is free...
  402.                 zData(i) = uMsg                                                     'Use this element
  403.                 GoTo Bail                                                           'Bail
  404.             ElseIf zData(i) = uMsg Then                                           'If the message is already in the table...
  405.                 GoTo Bail                                                           'Bail
  406.             End If
  407.         Next i                                                                  'Next message table entry
  408.  
  409.         nCount = i                                                              'On drop through: i = nCount + 1, the new table entry count
  410.         zData(nCount) = uMsg                                                    'Store the message in the appended table entry
  411.     End If
  412.  
  413.     zData(0) = nCount                                                         'Store the new table entry count
  414. Bail:
  415.     z_ScMem = nBase                                                           'Restore the value of z_ScMem
  416. End Sub
  417.  
  418. 'Delete the message from the specified table of the window handle
  419. Private Sub zDelMsg(ByVal uMsg As Long, ByVal nTable As Long)
  420.     Dim nCount As Long                                                        'Table entry count
  421.     Dim nBase  As Long                                                        'Remember z_ScMem
  422.     Dim i      As Long                                                        'Loop index
  423.  
  424.     nBase = z_ScMem                                                           'Remember z_ScMem so that we can restore its value on exit
  425.     z_ScMem = zData(nTable)                                                   'Map zData() to the specified table
  426.  
  427.     If uMsg = ALL_MESSAGES Then                                               'If ALL_MESSAGES are being deleted from the table...
  428.         zData(0) = 0                                                            'Zero the table entry count
  429.     Else
  430.         nCount = zData(0)                                                       'Get the table entry count
  431.  
  432.         For i = 1 To nCount                                                     'Loop through the table entries
  433.             If zData(i) = uMsg Then                                               'If the message is found...
  434.                 zData(i) = 0                                                        'Null the msg value -- also frees the element for re-use
  435.                 GoTo Bail                                                           'Bail
  436.             End If
  437.         Next i                                                                  'Next message table entry
  438.  
  439.         zError "zDelMsg", "Message &H" & Hex$(uMsg) & " not found in table"
  440.     End If
  441.  
  442. Bail:
  443.     z_ScMem = nBase                                                           'Restore the value of z_ScMem
  444. End Sub
  445.  
« Última modificación: 30 Junio 2008, 23:05 pm por ||MadAntrax|| » En línea
aaronduran2


Desconectado Desconectado

Mensajes: 790



Ver Perfil WWW
Re: Controlar el uso de memorias USB
« Respuesta #2 en: 30 Junio 2008, 23:00 pm »
Continúa del post anterior...
Código
  1. 'Map zData() to the thunk address for the specified window handle
  2. Private Function zMap_VFunction(ByVal vFuncTarget As Long, vType As eThunkType) As Long
  3.  
  4.     ' vFuncTarget is one of the following, depending on vType
  5.     '   - Subclassing:  the hWnd of the window subclassed
  6.     '   - Hooking:      the hook type created
  7.     '   - Callbacks:    the ordinal of the callback
  8.  
  9.     Dim thunkCol As Collection
  10.  
  11.     If vType = CallbackThunk Then
  12.         Set thunkCol = z_cbFunk
  13.     ElseIf vType = HookThunk Then
  14.         Set thunkCol = z_hkFunk
  15.     ElseIf vType = SubclassThunk Then
  16.         Set thunkCol = z_scFunk
  17.     Else
  18.         zError "zMap_Vfunction", "Invalid thunk type passed"
  19.         Exit Function
  20.     End If
  21.  
  22.     If thunkCol Is Nothing Then
  23.         zError "zMap_VFunction", "Thunk hasn't been initialized"
  24.     Else
  25.         On Error GoTo Catch
  26.         z_ScMem = thunkCol("h" & vFuncTarget)                    'Get the thunk address
  27.         zMap_VFunction = z_ScMem
  28.     End If
  29.     Exit Function                                               'Exit returning the thunk address
  30.  
  31. Catch:
  32.     zError "zMap_VFunction", "Thunk type for ID of " & vFuncTarget & " does not exist"
  33. End Function
  34.  
  35. 'Error handler
  36. Private Sub zError(ByVal sRoutine As String, ByVal sMsg As String)
  37.     ' \\LaVolpe -  Note. These two lines can be rem'd out if you so desire. But don't remove the routine
  38.     App.LogEvent TypeName(Me) & "." & sRoutine & ": " & sMsg, vbLogEventTypeError
  39.     MsgBox sMsg & ".", vbExclamation + vbApplicationModal, "Error in " & TypeName(Me) & "." & sRoutine
  40. End Sub
  41.  
  42. 'Return the address of the specified DLL/procedure
  43. Private Function zFnAddr(ByVal sDLL As String, ByVal sProc As String, ByVal asUnicode As Boolean) As Long
  44.     If asUnicode Then
  45.         zFnAddr = GetProcAddress(GetModuleHandleW(StrPtr(sDLL)), sProc)         'Get the specified procedure address
  46.     Else
  47.         zFnAddr = GetProcAddress(GetModuleHandleA(sDLL), sProc)                 'Get the specified procedure address
  48.     End If
  49.     Debug.Assert zFnAddr                                                      'In the IDE, validate that the procedure address was located
  50.     ' ^^ FYI VB5 users. Search for zFnAddr("vba6", "EbMode") and replace with zFnAddr("vba5", "EbMode")
  51. End Function
  52.  
  53. 'Return the address of the specified ordinal method on the oCallback object, 1 = last private method, 2 = second last private method, etc
  54. Private Function zAddressOf(ByVal oCallback As Object, ByVal nOrdinal As Long) As Long
  55.     ' Note: used both in subclassing and hooking routines
  56.     Dim bSub  As Byte                                                         'Value we expect to find pointed at by a vTable method entry
  57.     Dim bVal  As Byte
  58.     Dim nAddr As Long                                                         'Address of the vTable
  59.     Dim i     As Long                                                         'Loop index
  60.     Dim j     As Long                                                         'Loop limit
  61.  
  62.     RtlMoveMemory VarPtr(nAddr), ObjPtr(oCallback), 4                         'Get the address of the callback object's instance
  63.     If Not zProbe(nAddr + &H1C, i, bSub) Then                                 'Probe for a Class method
  64.         If Not zProbe(nAddr + &H6F8, i, bSub) Then                              'Probe for a Form method
  65.             ' \\LaVolpe - Added propertypage offset
  66.             If Not zProbe(nAddr + &H710, i, bSub) Then                            'Probe for a PropertyPage method
  67.                 If Not zProbe(nAddr + &H7A4, i, bSub) Then                          'Probe for a UserControl method
  68.                     Exit Function                                                   'Bail...
  69.                 End If
  70.             End If
  71.         End If
  72.     End If
  73.  
  74.     i = i + 4                                                                 'Bump to the next entry
  75.     j = i + 1024                                                              'Set a reasonable limit, scan 256 vTable entries
  76.     Do While i < j
  77.         RtlMoveMemory VarPtr(nAddr), i, 4                                       'Get the address stored in this vTable entry
  78.  
  79.         If IsBadCodePtr(nAddr) Then                                             'Is the entry an invalid code address?
  80.             RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4               'Return the specified vTable entry address
  81.             Exit Do                                                               'Bad method signature, quit loop
  82.         End If
  83.  
  84.         RtlMoveMemory VarPtr(bVal), nAddr, 1                                    'Get the byte pointed to by the vTable entry
  85.         If bVal <> bSub Then                                                    'If the byte doesn't match the expected value...
  86.             RtlMoveMemory VarPtr(zAddressOf), i - (nOrdinal * 4), 4               'Return the specified vTable entry address
  87.             Exit Do                                                               'Bad method signature, quit loop
  88.         End If
  89.  
  90.         i = i + 4                                                               'Next vTable entry
  91.     Loop
  92. End Function
  93.  
  94. 'Probe at the specified start address for a method signature
  95. Private Function zProbe(ByVal nStart As Long, ByRef nMethod As Long, ByRef bSub As Byte) As Boolean
  96.     Dim bVal    As Byte
  97.     Dim nAddr   As Long
  98.     Dim nLimit  As Long
  99.     Dim nEntry  As Long
  100.  
  101.     nAddr = nStart                                                            'Start address
  102.     nLimit = nAddr + 32                                                       'Probe eight entries
  103.     Do While nAddr < nLimit                                                   'While we've not reached our probe depth
  104.         RtlMoveMemory VarPtr(nEntry), nAddr, 4                                  'Get the vTable entry
  105.  
  106.         If nEntry <> 0 Then                                                     'If not an implemented interface
  107.             RtlMoveMemory VarPtr(bVal), nEntry, 1                                 'Get the value pointed at by the vTable entry
  108.             If bVal = &H33 Or bVal = &HE9 Then                                    'Check for a native or pcode method signature
  109.                 nMethod = nAddr                                                     'Store the vTable entry
  110.                 bSub = bVal                                                         'Store the found method signature
  111.                 zProbe = True                                                       'Indicate success
  112.                 Exit Do                                                             'Return
  113.             End If
  114.         End If
  115.  
  116.         nAddr = nAddr + 4                                                       'Next vTable entry
  117.     Loop
  118. End Function
  119.  
  120. Private Function zInIDE() As Long
  121.     ' This is only run in IDE; it is never run when compiled
  122.     z_IDEflag = 1
  123.     zInIDE = z_IDEflag
  124. End Function
  125.  
  126. Private Property Get zData(ByVal nIndex As Long) As Long
  127.     ' retrieves stored value from virtual function's memory location
  128.     RtlMoveMemory VarPtr(zData), z_ScMem + (nIndex * 4), 4
  129. End Property
  130.  
  131. Private Property Let zData(ByVal nIndex As Long, ByVal nValue As Long)
  132.     ' sets value in virtual function's memory location
  133.     RtlMoveMemory z_ScMem + (nIndex * 4), VarPtr(nValue), 4
  134. End Property
  135.  
  136. Private Sub zUnThunk(ByVal thunkID As Long, ByVal vType As eThunkType)
  137.     ' Releases a specific subclass, hook or callback
  138.     ' thunkID depends on vType:
  139.     '   - Subclassing:  the hWnd of the window subclassed
  140.     '   - Hooking:      the hook type created
  141.     '   - Callbacks:    the ordinal of the callback
  142.  
  143.     Const IDX_SHUTDOWN  As Long = 1
  144.     Const MEM_RELEASE As Long = &H8000&                                'Release allocated memory flag
  145.  
  146.     If zMap_VFunction(thunkID, vType) Then
  147.         Select Case vType
  148.             Case SubclassThunk
  149.                 If IsBadCodePtr(z_ScMem) = 0 Then       'Ensure that the thunk hasn't already released its memory
  150.                     zData(IDX_SHUTDOWN) = 1             'Set the shutdown indicator
  151.                     zDelMsg ALL_MESSAGES, IDX_BTABLE    'Delete all before messages
  152.                     zDelMsg ALL_MESSAGES, IDX_ATABLE    'Delete all after messages
  153.                     '\\LaVolpe - Force thunks to replace original window procedure handle. Without this, app can crash when a window is subclassed multiple times simultaneously
  154.                     If zData(IDX_UNICODE) Then          'Force window procedure handle to be replaced
  155.                         SendMessageW thunkID, 0&, 0&, ByVal 0&
  156.                     Else
  157.                         SendMessageA thunkID, 0&, 0&, ByVal 0&
  158.                     End If
  159.                 End If
  160.                 z_scFunk.Remove "h" & thunkID           'Remove the specified thunk from the collection
  161.             Case HookThunk
  162.                 If IsBadCodePtr(z_ScMem) = 0 Then       'Ensure that the thunk hasn't already released its memory
  163.                     zData(IDX_SHUTDOWN) = 1             'Set the shutdown indicator
  164.                     zData(IDX_ATABLE) = 0               ' want no more After messages
  165.                     zData(IDX_BTABLE) = 0               ' want no more Before messages
  166.                 End If
  167.                 z_hkFunk.Remove "h" & thunkID           'Remove the specified thunk from the collection
  168.             Case CallbackThunk
  169.                 If IsBadCodePtr(z_ScMem) = 0 Then       'Ensure that the thunk hasn't already released its memory
  170.                     VirtualFree z_ScMem, 0, MEM_RELEASE 'Release allocated memory
  171.                 End If
  172.                 z_cbFunk.Remove "h" & thunkID           'Remove the specified thunk from the collection
  173.         End Select
  174.     End If
  175.  
  176. End Sub
  177.  
  178. Private Sub zTerminateThunks(ByVal vType As eThunkType)
  179.     ' Removes all thunks of a specific type: subclassing, hooking or callbacks
  180.     Dim i As Long
  181.     Dim thunkCol As Collection
  182.  
  183.     Select Case vType
  184.         Case SubclassThunk
  185.             Set thunkCol = z_scFunk
  186.         Case HookThunk
  187.             Set thunkCol = z_hkFunk
  188.         Case CallbackThunk
  189.             Set thunkCol = z_cbFunk
  190.         Case Else
  191.             Exit Sub
  192.     End Select
  193.  
  194.     If Not (thunkCol Is Nothing) Then                 'Ensure that hooking has been started
  195.         With thunkCol
  196.             For i = .Count To 1 Step -1                   'Loop through the collection of hook types in reverse order
  197.                 z_ScMem = .Item(i)                          'Get the thunk address
  198.                 If IsBadCodePtr(z_ScMem) = 0 Then           'Ensure that the thunk hasn't already released its memory
  199.                     Select Case vType
  200.                         Case SubclassThunk
  201.                             zUnThunk zData(IDX_INDEX), SubclassThunk     'Unsubclass
  202.                         Case HookThunk
  203.                             zUnThunk zData(IDX_INDEX), HookThunk             'Unhook
  204.                         Case CallbackThunk
  205.                             zUnThunk zData(IDX_CALLBACKORDINAL), CallbackThunk ' release callback
  206.                     End Select
  207.                 End If
  208.             Next i                                        'Next member of the collection
  209.         End With
  210.         Set thunkCol = Nothing                         'Destroy the hook/thunk-address collection
  211.     End If
  212. End Sub
  213.  
  214. Private Function GetDriveBusType(ByVal sDrive As String) As STORAGE_BUS_TYPE
  215.     Dim lret                        As Long
  216.     Dim lDevice                     As Long
  217.     Dim tSTORAGE_DEVICE_DESCRIPTOR  As STORAGE_DEVICE_DESCRIPTOR
  218.     Dim tOVERLAPPED                 As OVERLAPPED
  219.     Dim tSTORAGE_PROPERTY_QUERY     As STORAGE_PROPERTY_QUERY
  220.  
  221.     sDrive = Left(sDrive, 1) & ":"
  222.  
  223.     lDevice = CreateFile("\\.\" & sDrive, GENERIC_READ, _
  224.        FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
  225.  
  226.     If Not lDevice = INVALID_HANDLE_VALUE Then
  227.         With tSTORAGE_PROPERTY_QUERY
  228.             .PropertyId = StorageDeviceProperty
  229.             .QueryType = PropertyStandardQuery
  230.         End With
  231.  
  232.         Call DeviceIoControl(lDevice, _
  233.            IOCTL_STORAGE_QUERY_PROPERTY, _
  234.            tSTORAGE_PROPERTY_QUERY, _
  235.            LenB(tSTORAGE_PROPERTY_QUERY), _
  236.            tSTORAGE_DEVICE_DESCRIPTOR, _
  237.            LenB(tSTORAGE_DEVICE_DESCRIPTOR), _
  238.            lret, tOVERLAPPED)
  239.  
  240.         GetDriveBusType = tSTORAGE_DEVICE_DESCRIPTOR.BusType
  241.         Call CloseHandle(lDevice)
  242.     End If
  243.  
  244. End Function
  245.  
  246. Private Function IOCTL_STORAGE_QUERY_PROPERTY() As Long
  247.     IOCTL_STORAGE_QUERY_PROPERTY = _
  248.        (IOCTL_STORAGE_BASE * 2 ^ 16) Or _
  249.        (FILE_ANY_ACCESS * 2 ^ 14) Or _
  250.        (&H500 * 2 ^ 2) Or _
  251.        (METHOD_BUFFERED)
  252. End Function
  253.  
  254. Private Function UnitFromMask(ByVal lMask As Long) As String
  255.     Dim i As Long
  256.     For i = 0 To 25
  257.         If (lMask And 2 ^ i) Then
  258.             UnitFromMask = Chr$(i + Asc("A"))
  259.             Exit Function
  260.         End If
  261.     Next
  262. End Function
  263.  
  264. '- ordinal #1
  265. Private Sub WndProc( _
  266.        ByVal bBefore As Boolean, _
  267.        ByRef bHandled As Boolean, _
  268.        ByRef lReturn As Long, _
  269.        ByVal lng_hWnd As Long, _
  270.        ByVal uMsg As Long, _
  271.        ByVal wParam As Long, _
  272.        ByVal lParam As Long, _
  273.        ByRef lParamUser As Long)
  274.  
  275.     Dim tDEV_BROADCAST_HDR      As DEV_BROADCAST_HDR
  276.     Dim tDEV_BROADCAST_VOLUME   As DEV_BROADCAST_VOLUME
  277.     Dim sDrive                  As String
  278.  
  279.     Select Case wParam
  280.  
  281.         Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE
  282.  
  283.             Call CopyMemory(tDEV_BROADCAST_HDR, _
  284.                ByVal lParam, LenB(tDEV_BROADCAST_HDR))
  285.  
  286.             If tDEV_BROADCAST_HDR.dbch_devicetype = DBT_DEVTYP_VOLUME Then
  287.  
  288.                 Call CopyMemory(tDEV_BROADCAST_VOLUME, _
  289.                    ByVal lParam, LenB(tDEV_BROADCAST_VOLUME))
  290.  
  291.                 sDrive = UnitFromMask(tDEV_BROADCAST_VOLUME.dbcv_unitmask)
  292.  
  293.                 If Not sDrive = vbNullString Then
  294.                     If wParam = DBT_DEVICEARRIVAL Then
  295.                         If GetDriveBusType(sDrive) = BusTypeUsb Then
  296.                             RaiseEvent DriveArrival(sDrive, GetDriveType(sDrive & ":\"))
  297.                         End If
  298.                     Else
  299.                         RaiseEvent DriveRemoval(sDrive)
  300.                     End If
  301.                 End If
  302.  
  303.             End If
  304.  
  305.     End Select
  306.  
  307. End Sub
  308.  
  309. ' *************************************************************
  310. ' C A U T I O N   C A U T I O N   C A U T I O N   C A U T I O N
  311. ' -------------------------------------------------------------
  312. ' DO NOT ADD ANY OTHER CODE BELOW THE "END SUB" STATEMENT BELOW
  313. '   add this warning banner to the last routine in your class
  314. ' *************************************************************
  315.  

La forma de usarla es la siguiente:

- En un form, declaras la clase.
- En el evento DriveArrival de la clase, colocas el siguiente código:
Código
  1. MsgBox "Detectada ", sDrive, lDriveType
  2.  
- En el evento DriveRemoval:
Código
  1. MsgBox "Extraída ", sDrive
  2.  

Saludos, y perdón por el post tan largo.
« Última modificación: 30 Junio 2008, 23:05 pm por ||MadAntrax|| » En línea
Mad Antrax
Colaborador
***
Desconectado Desconectado

Mensajes: 2.166


Cheats y Trainers para todos!


Ver Perfil WWW
Re: Controlar el uso de memorias USB
« Respuesta #3 en: 30 Junio 2008, 23:07 pm »
Cita de: aaronduran2 en 30 Junio 2008, 23:00 pm
Saludos, y perdón por el post tan largo.

Perdonado, pero usa las etiquetas de código GeSHI, ejemplo

Código:
[code][/ code] No se utiliza

Código:
[code=vb][/ code] Sí se utiliza

Así queda en formato VB6 y mola más :xD

Saludos!![/code][/code]
En línea
No hago hacks/cheats para juegos Online.
Tampoco ayudo a nadie a realizar hacks/cheats para juegos Online.
aaronduran2


Desconectado Desconectado

Mensajes: 790



Ver Perfil WWW
Re: Controlar el uso de memorias USB
« Respuesta #4 en: 30 Junio 2008, 23:09 pm »
Gracias, ||MadAntrax||. Lo haré la próxima vez.
En línea
josp24

Desconectado Desconectado

Mensajes: 9


Ver Perfil
Re: Controlar el uso de memorias USB
« Respuesta #5 en: 1 Julio 2008, 02:01 am »
Muchas gracias por tu aporte aaronduran2. Ya tome el código que me pasaste e hice lo que me dijiste al pie de la letra, pero fijate que cuando corro el programa e inserto o extraigo la memoria USB, no pasa nada, no me salta ningún mensaje.

Qué puede estar sucediendo? Espero tu respuesta, gracias.
En línea
josp24

Desconectado Desconectado

Mensajes: 9


Ver Perfil
Re: Controlar el uso de memorias USB
« Respuesta #6 en: 1 Julio 2008, 02:32 am »
ok, no me daba ningun mensaje porque me faltaba la siguiente línea:

Private Sub Form_Load()
    Set USB = New clsUSB
End Sub

Pero ahora cuando introduzco la memoria o la extraigo me da el siguiente error:

Error 13 en tiempo de ejecución: No coinciden los tipos.

Este error me da en las siguientes líneas:

Private Sub USB_DriveArrival(ByVal sDrive As String, ByVal lDriveType As eDriveType)
    MsgBox "Detectada", sDrive, lDriveType
End Sub

Private Sub USB_DriveRemoval(ByVal sDrive As String)
    MsgBox "Extraída", sDrive
End Sub
En línea
cobein


Desconectado Desconectado

Mensajes: 759



Ver Perfil WWW
Re: Controlar el uso de memorias USB
« Respuesta #7 en: 1 Julio 2008, 02:33 am »
Podes descargar un ejemplo funcional de aca

USB detection.zip on UpSourceCode.com.ar


Edit reemplaza las comas por &
En línea
http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.
josp24

Desconectado Desconectado

Mensajes: 9


Ver Perfil
Re: Controlar el uso de memorias USB
« Respuesta #8 en: 1 Julio 2008, 02:48 am »
Perfecto COBEIN ya me funciona bien !!!

Solo que en los mensajes se colocan unos caracteres al final:

DetectadaF2

ExtraidaF

Ahora cómo puedo hacer para que no se pueda usar la memoria usb hasta que el usuario se idéntifique o en su defecto rechazarla?
En línea
krackwar


Desconectado Desconectado

Mensajes: 900


Ver Perfil
Re: Controlar el uso de memorias USB
« Respuesta #9 en: 1 Julio 2008, 03:24 am »
Cita de: josp24 en  1 Julio 2008, 02:48 am
Perfecto COBEIN ya me funciona bien !!!

Solo que en los mensajes se colocan unos caracteres al final:

DetectadaF2

ExtraidaF

Ahora cómo puedo hacer para que no se pueda usar la memoria usb hasta que el usuario se idéntifique o en su defecto rechazarla?
Quieres que te lo agamos todo  :huh: .Google no muerde
En línea
Mi blog
Bienvenido krackwar, actualmente tu puntuación es de 38 puntos y tu rango es Veteran.
El pollo número 1, es decir yo, (krackwar), adoro a Shaddy como a un dios.
Páginas: [1] 2 Ir Arriba Respuesta Imprimir 

Ir a:  
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines