Penulis Topik: Cara mendeteksi flashdisk dengan Simple :)  (Dibaca 1721 kali)

Offline Frans Mangarahut Situmorang

  • Pro200
  • *****
  • Tulisan: 204
  • Reputation: 281
    • Lihat Profil
Cara mendeteksi flashdisk dengan Simple :)
« pada: Juli 06, 2012, 05:45:46 AM »
Hem,,,, yang ingin menambahkan fitur Cek Flashdisk pada Antivirus silahkan gunakan ini bang  ^_^ ^_^ ^_^ ^_^ ^_^ ^_^ ^_^


Step by Step

sediakan 1 from dan 1 module dan 2 Option Button

From.Name = Linda
Module.Name = basLind

Option1.Name = OpOne
           Caption = Detected Part 1

Option2.Name = OpTwo
           Caption = Detected Part 2

Masukan code berikut pada form  :-bd :-bd :-bd :-bd :-bd
Kode: [Pilih]
Private Declare Function RegisterDeviceNotification Lib "User32.dll" Alias _
  "RegisterDeviceNotificationA" (ByVal hRecipient As Long, _
  ByRef NotificationFilter As Any, ByVal Flags As Long) As Long
Private Declare Function UnregisterDeviceNotification Lib "User32.dll" ( _
  ByVal Handle As Long) As Long
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type DEV_BROADCAST_DEVICEINTERFACE
dbcc_size As Long
dbcc_devicetype As Long
dbcc_reserved As Long
dbcc_classguid As Guid
dbcc_name As Long
End Type

Private hDevNotify As Long
Private Const DEVICE_NOTIFY_WINDOW_HANDLE As Long = &H0
Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5 ' Device interface class
Private Const DEVICE_NOTIFY_ALL_INTERFACE_CLASSES As Long = &H4
Private Sub Form_Load()
If OpOne Then
Call UnSubclass1
Else
Call UnregisterDeviceNotification(hDevNotify)
Call UnSubClass2
End If
End Sub

Private Sub OpOne_Click()
Call UnregisterDeviceNotification(hDevNotify)
Call UnSubClass2
Call Subclass1(Me.hWnd)
End Sub

Private Sub OpTwo_Click()
Call UnSubclass1
Dim NotificationFilter As DEV_BROADCAST_DEVICEINTERFACE
With NotificationFilter
.dbcc_size = Len(NotificationFilter)
.dbcc_devicetype = DBT_DEVTYP_DEVICEINTERFACE
End With
Call SubClass2(Me.hWnd)
hDevNotify = RegisterDeviceNotification(Me.hWnd, NotificationFilter, _
DEVICE_NOTIFY_WINDOW_HANDLE Or DEVICE_NOTIFY_ALL_INTERFACE_CLASSES)
End Sub

Dan masukan code ini pada Module = basLind
Kode: [Pilih]
Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "User32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function StringFromGUID2 Lib "OLE32.dll" (ByRef rGUID As Any, ByVal lpSz As String, ByVal cchMax As Long) As Long
Private Declare Function lstrcpyA Lib "Kernel32.dll" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32.dll" (ByVal lpString As Long) As Long
Private Declare Function GetDriveType Lib "Kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub GetDWord Lib "MSVBVM60.dll" Alias "GetMem4" (ByRef inSrc As Any, ByRef inDst As Long)
Private Declare Sub GetWord Lib "MSVBVM60.dll" Alias "GetMem2" (ByRef inSrc As Any, ByRef inDst As Integer)

Private m_hWnd As Long, m_OldProc As Long

Private Type DEV_BROADCAST_HDR
dbch_size As Long
dbch_devicetype As Long
dbch_reserved As Long
End Type

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Dim OldProc As Long
Dim WndHnd As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DEVICECHANGE As Long = &H219
Private Const DBT_DEVNODES_CHANGED As Long = &H7
Private Const DBT_DEVICEARRIVAL As Long = &H8000&
Private Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
Private Const DBT_DEVTYP_VOLUME As Long = &H2
Private Const DBT_DEVTYP_DEVICEINTERFACE As Long = &H5
Private Const DBTF_MEDIA As Long = &H1
Private Const DBTF_NET As Long = &H2
Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK As Long = 6

Public Sub SubClass2(ByVal inWnd As Long)
If (WndHnd) Then Call UnSubClass2
OldProc = SetWindowLong(inWnd, GWL_WNDPROC, AddressOf WndProc2)
WndHnd = inWnd
End Sub

Public Sub UnSubClass2()
If (WndHnd = 0) Then Exit Sub
Call SetWindowLong(WndHnd, GWL_WNDPROC, OldProc)
WndHnd = 0
OldProc = 0
End Sub

Private Function WndProc2(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim DevBroadcastHeader As DEV_BROADCAST_HDR
Dim UnitMask As Long, Flags As Integer
Dim DeviceGUID As Guid
Dim DeviceNamePtr As Long
Dim DriveLetters As String
Dim LoopDrives As Long
If (uMsg = WM_DEVICECHANGE) Then
Select Case wParam
Case DBT_DEVICEARRIVAL, DBT_DEVICEREMOVECOMPLETE
If (lParam) Then
Call RtlMoveMemory(DevBroadcastHeader, ByVal lParam, Len(DevBroadcastHeader))
If (DevBroadcastHeader.dbch_devicetype = DBT_DEVTYP_VOLUME) Then
Call GetDWord(ByVal (lParam + Len(DevBroadcastHeader)), UnitMask)
Call GetWord(ByVal (lParam + Len(DevBroadcastHeader) + 4), Flags)
DriveLetters = UnitMaskToString(UnitMask)
For LoopDrives = 1 To Len(DriveLetters)
MsgBox "Drive " & Mid$(DriveLetters, LoopDrives, 1) & " " & _
IIf(wParam = DBT_DEVICEARRIVAL, "Inserted", "Ejected") & " (" & _
DriveTypeToString(GetDriveType(Mid$(DriveLetters, LoopDrives, 1) & ":\")) & ")", _
vbInformation + vbSystemModal
Next LoopDrives
ElseIf (DevBroadcastHeader.dbch_devicetype = DBT_DEVTYP_DEVICEINTERFACE) Then
Call RtlMoveMemory(DeviceGUID, ByVal (lParam + Len(DevBroadcastHeader)), Len(DeviceGUID))
Call GetDWord(ByVal (lParam + Len(DevBroadcastHeader) + Len(DeviceGUID)), DeviceNamePtr)
MsgBox "Device GUID: " & GUIDToString(DeviceGUID) & _
", name: """ & CopyStringA(DeviceNamePtr) & """", _
vbInformation + vbSystemModal
End If
End If
Case DBT_DEVNODES_CHANGED
Debug.Print "Device added or removed"
End Select
End If
WndProc2 = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam)
End Function

Private Function UnitMaskToString(ByVal inUnitMask As Long) As String
Dim LoopBits As Long
For LoopBits = 0 To 30
If (inUnitMask And (2 ^ LoopBits)) Then _
UnitMaskToString = UnitMaskToString & Chr$(Asc("A") + LoopBits)
Next LoopBits
End Function

Private Function GUIDToString(ByRef inGUID As Guid) As String
Dim RetBuf As String, GUILen As Long
Const BufLen As Long = 80
RetBuf = Space$(BufLen)
GUILen = StringFromGUID2(inGUID, RetBuf, BufLen)
If (GUILen) Then GUIDToString = StrConv(Left$(RetBuf, (GUILen - 1) * 2), vbFromUnicode)
End Function

Public Function CopyStringA(ByVal inPtr As Long) As String
Dim BufLen As Long
BufLen = lstrlenA(inPtr)
If (BufLen > 0) Then
CopyStringA = Space$(BufLen)
Call lstrcpyA(CopyStringA, inPtr)
End If
End Function

Private Function DriveTypeToString(ByVal inDriveType As Long) As String
Select Case inDriveType
Case DRIVE_NO_ROOT_DIR:
DriveTypeToString = "No root directory" '??
Case DRIVE_REMOVABLE:
DriveTypeToString = "Removable"
Case DRIVE_FIXED:
DriveTypeToString = "Fixed"
Case DRIVE_REMOTE:
DriveTypeToString = "Remote"
Case DRIVE_CDROM:
DriveTypeToString = "CD-ROM"
Case DRIVE_RAMDISK:
DriveTypeToString = "RAM disk"
Case Else:
DriveTypeToString = "[ Unknown ]"
End Select
End Function

Public Sub Subclass1(ByVal inWnd As Long)
If (m_hWnd) Then Call UnSubclass1
m_OldProc = SetWindowLong(inWnd, GWL_WNDPROC, AddressOf WndProc1)
m_hWnd = inWnd
End Sub

Public Sub UnSubclass1()
If (m_hWnd) Then
Call SetWindowLong(m_hWnd, GWL_WNDPROC, m_OldProc)
m_hWnd = 0
m_OldProc = 0
End If
End Sub

Private Function WndProc1(ByVal hWnd As Long, _
  ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If (uMsg = WM_DEVICECHANGE) Then
If (wParam = DBT_DEVICEARRIVAL) Then
MsgBox "Terdeteksi Flash Disk Guys XD", vbInformation + vbSystemModal
ElseIf (wParam = DBT_DEVICEREMOVECOMPLETE) Then
MsgBox "Kok dicabut sih flashdisknya guys ? :'(", vbInformation + vbSystemModal
End If
End If
WndProc1 = CallWindowProc(m_OldProc, hWnd, uMsg, wParam, lParam)
End Function

Mau Instant ? Langsung download aja  :-* :-* :-* :-* :-* :-* :-* :-*
Tuhan menempatkanmu didunia ini bukan tuk membaca kisah orang lain, Tapi Tuhan menempatkanmu tuk melakukan sesuatu yang membuat orang lain ingin membaca kisahmu.

Offline ghosilay

  • Pro200
  • *****
  • Tulisan: 323
  • Reputation: 234
  • TOG ( Team Of Ghosilay)
    • Lihat Profil
Re: Cara mendeteksi flashdisk dengan Simple :)
« Jawab #1 pada: Juli 06, 2012, 10:34:23 AM »
saya pernah lihat SC ini  :-\ tolong cantumkan credit pembuatnya gan
anda gagal karena sulit belajar?? hubungi saya, maka saya akan membantu anda melarikan diri :)

Offline ronie jack

  • Pro100
  • ****
  • Tulisan: 163
  • Reputation: 168
    • Lihat Profil
Re: Cara mendeteksi flashdisk dengan Simple :)
« Jawab #2 pada: Oktober 26, 2012, 02:23:17 PM »
thx