Klavye Seri Numarası

[bedersu]

Merhaba arkadaşlar,
HDD seri numarasını bulan kodlar gibi,klavye ve mouse un da seri numarası bulunabilir mi?
Teşekkürler.

 

[Mahmut Bayram]

Şu kodlar mouse içindir (Haluk abinin kodlarıdır.)

Sub InfoPointingDevices()
Dim MyOBJ As Object
Dim MyPtgDev As Variant
Dim MyMsg As String
On Error Resume Next
Set MyOBJ = GetObject("WinMgmts:").instancesOf _
            ("win32_pointingdevice")
If Err.Number <> 0 Then
  MsgBox "WMI yüklenmemiş! Programdan çıkılacak...", vbExclamation, _
  "Windows Management Instrumentation"
  Exit Sub
On Error GoTo 0
End If
For Each MyPtgDev In MyOBJ
    MyMsg = MyMsg & "*****************************" & vbCrLf
    MyMsg = MyMsg & "İşlemci : " & Trim(MyCPU.Name) & vbCrLf
    MyMsg = MyMsg & "Ad : " & MyPtgDev.Name & vbCrLf
    MyMsg = MyMsg & "Üretici   : " & MyPtgDev.Manufacturer & vbCrLf
    MyMsg = MyMsg & "Buton adedi    : " & MyPtgDev.NumberOfButtons & vbCrLf
Next
MsgBox MyMsg, vbInformation, "Mouse Bilgileri   (Raider ®)"
End Sub

Şunlar ise tarafımdan klavye için derlenmiştir.

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Sub wmiKeyboardInfo()
   Set wmiobjset = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                                        InstancesOf("Win32_Keyboard")
   For Each obj In wmiobjset
    MsgBox obj.DeviceID
   Next
End Sub

 

[bedersu]

teşekkür ederim Sayın Mahmutt.Kodları deneyeceğim hemen.Sayın Haluk zaten muhteşem bu konuda.Her ikinize de tekrar teşekkür ediyorum

 

[baydeniro]

Paylaşım için teşekkürler