• Thứ Hai, 18/01/2010 09:09 (GMT+7)

    Lập trình phát hiện USB bằng VB6

    Câu hỏi :
    Xin hướng dẫn viết chương trình VB 6.0 phát hiện USB khi cắm vào máy tính.


    Trả lời :
     Trong khi hoạt động, mỗi cửa sổ ứng dụng đều có 1 hàm xử lý sự kiện kết hợp, hàm này sẽ được hệ thống gọi mỗi khi có 1 sự kiện nào đó (từ thiết bị I/O hay từ ứng dụng khác) gửi cho cửa sổ ứng dụng hiện hành. Khi thiết bị I/O nào đó thay đổi trạng thái hoạt động, nó sẽ gửi về cửa sổ ứng dụng 1 sự kiện có tên là WM_DEVICECHANGE. Do đó để phát hiện đĩa USB hay CD được để vào/rút ra khỏi máy, bạn có thể viết hàm xử lý sự kiện cho cửa sổ ứng dụng của mình để chặn bắt sự kiện WM_DEVICECHANGE. Sau đây là qui trình điển hình để xây dựng ứng dụng VB 6.0 đơn giản có khả năng phát hiện việc gắn vào/rút ra 1 thiết bị chứa tin nào đó và hiển thị thông báo lên ListBox cho người dùng biết:

     1. Chạy VB 6.0, tạo Project loại "Standard EXE". Khi Form trống hiển thị, vẽ 1 ListBox vào Form, thiết lập thuộc tính (Name) của ListBox = lbOutput.
     2. Chọn menu View.Code để hiển thị cửa sổ soạn code cho Form. Chọn mục Form trong listbox phía trên bên trái cửa sổ code để tạo thủ tục Form_Load rồi viết đoạn code VB 6.0 sau đây vào:
     'thủ tục khởi động Form
     Private Sub Form_Load()
     gHW = Me.hwnd
     'đăng ký hàm xử lý sự kiện cho form
     Hook
     End Sub
     
     'thủ tục đóng Form
     Private Sub Form_Unload(Cancel As Integer)
     'gỡ bỏ hàm xử lý sự kiện cho form
     Unhook
     End Sub
     3. Dời chuột về cửa sổ Project phía trên phải, nhấn phải chuột trên tên của Project (mặc định là Project1), chọn chức năng Add.Module để tạo thêm 1 "Standard Module" mới tên là Module1 rồi nhập đoạn code VB 6.0 sau vào module:
     Option Explicit
     'định nghĩa các kiểu dữ liệu cần dùng
     Public Type DEV_BROADCAST_HDR
     size As Long
     devicetype As Long
     reserved As Long
     End Type
     
     Public Type DEV_BROADCAST_VOLUME
     size As Long
     devicetype As Long
     reserved As Long
     unitmask As Long
     flags As Long
     End Type
     
     'định nghĩa các hằng dữ liệu cần dùng
     Public Const DBT_DEVTYP_VOLUME = &H2
     Public Const WM_DEVICECHANGE = &H219
     Public Const DBT_DEVICEARRIVAL = &H8000&
     Public Const DBT_DEVICEREMOVECOMPLETE = &H8004&
     
     Public Const GWL_WNDPROC = (-4)
     
     'định nghĩa các biến dữ liệu cần dùng
     Global lpPrevWndProc As Long
     Global gHW As Long
     
     'Khai báo các hàm API cần dùng
     Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
     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
     Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     
     'Thủ tục đăng ký hàm xử lý sự kiện cho form
     Public Sub Hook()
     lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
     End Sub
     
     'Thủ tục gở bỏ hàm xử lý sự kiện cho form
     Public Sub Unhook()
     Dim temp As Long
     temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
     End Sub
     
     'Thủ tục xác định tên ổ đĩa
     Private Function GetDriveFromMask(unitmask As Integer) As String
     'dựa vào nội dung của unitmask:
     ' 1 = A, 2 = B, 4 = C, 8 = D, 16 = E,...
     GetDriveFromMask = Chr(65 + (Log(unitmask) / Log(2)))
     End Function
     
     'hàm xử lý sự kiện cho form
     'hàm này được kích hoạt mỗi khi có sự kiện gửi đến Form
     Public Function WindowProc(ByVal hWindow As Long, ByVal uMsg As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
     'định nghĩa các biến cần dùng
     Dim sDrive As String
     Dim dbHdr As DEV_BROADCAST_HDR
     Dim dbVol As DEV_BROADCAST_VOLUME
     'kiểm tra sự kiện
     Select Case uMsg
     'nếu là sự kiện WM_DEVICECHANGE
     Case WM_DEVICECHANGE
     Select Case wParam
     'nếu là sự kiện để đĩa vào
     Case DBT_DEVICEARRIVAL:
     CopyMemory dbHdr, ByVal lParam, Len(dbHdr)
     'kiểm tra có phải thiết bị chứa tin
     If dbHdr.devicetype = DBT_DEVTYP_VOLUME Then
     CopyMemory dbVol, ByVal lParam, Len(dbVol)
     'xác định tên thiết bị chứa tin
     sDrive = GetDriveFromMask(CInt(dbVol.unitmask))
     'hiển thị chuỗi miêu tả sự kiện
     Form1.lbOutput.AddItem "thiết bị vừa được đưa vào ổ " & sDrive & ":"
     End If
     'nếu là sự kiện rút đĩa ra
     Case DBT_DEVICEREMOVECOMPLETE:
     CopyMemory dbHdr, ByVal lParam, Len(dbHdr)
     'kiểm tra có phải thiết bị chứa tin
     If dbHdr.devicetype = DBT_DEVTYP_VOLUME Then
     CopyMemory dbVol, ByVal lParam, Len(dbVol)
     'xác định tên thiết bị chứa tin
     sDrive = GetDriveFromMask(CInt(dbVol.unitmask))
     'hiển thị chuỗi miêu tả sự kiện
     Form1.lbOutput.AddItem "thiết bị vừa được rút ra từ ổ " & sDrive & ":"
     End If
     Case Else
     'không làm gì hết
     End Select
     Case Else
     'không làm gì hết
     End Select
     'tiếp tục gọi hàm xứ lý của hệ thống
     WindowProc = CallWindowProc(lpPrevWndProc, hWindow, uMsg, wParam, lParam)
     End Function
     4. Chọn menu Run.Start để chạy ứng dụng, thử để CD vào ổ và tháo ra, thử cắm USB vào và tháo ra, bạn sẽ thấy thông báo xuất hiện trên ListBox. 
     
    Chuyên mục: Lập trình