• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Lấy thông tin hardware

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Lấy thông tin hardware

Gửi bàigửi bởi dactung93 » T.Tư 24/02/2010 3:17 pm

Thủ thuật:
Tác giả: Sưu tầm từ nhiều nguồn + Edit
Mô tả: Cái này giúp ta có thể kiểm tra được các thiết bị phần cứng của máy như
+ Garsas
+ Video
+ Network
+ Keyboard
+ Mouse
+ Disk
+ CD-Rom
+SCSI
+ Processer
+ Memory
+ Flopyy
+ Modem
+ Infrared
+ FCMCID
+ Tape
+ Battery ( Dùng cho máy tính sách tay )


From chính gồm 1 button, 1 textbox đặt tên là txtHW ( Hoặc bạn thay đổi tùy ý cũng được )

Đầu tiên ta tạo một module khai báo như sau
  1. 'Hardware scanner
  2. '================
  3. Public isClient As Boolean
  4. Public isClienta As Boolean
  5. Public strUserName As String
  6. Public strPassword As String
  7. Public klientoID As Integer
  8. Public webUserName As String
  9. Public webPassword As String
  10. Public oDeviceType() As Variant
  11. Public oDeviceCaption() As Variant
  12. Public oDeviceParam() As Variant
  13. Public oDeviceInterf() As Variant
  14. Public eilute As Integer
  15. Public isHardware As Boolean
  16.  
  17.  


Quay trở lại From chính.
Khai báo trong from

  1. 'Hardware scanner
  2. Dim DeviceFound() As Variant
  3. Dim DeviceList() As Variant
  4. Dim DeviCecount As Integer
  5. Dim ramas As Variant
  6. Dim ramotipas As Variant
  7. Dim PelesInt() As Variant
  8. Dim PelesTipas() As Variant
  9. Dim objWshNet, DeviceListLen, strServer, objService, isconnect, objDeviceSet, Device


Chúng ta có 3 hàm để thực hiện các công việc

  1. Public Sub scanhard()
  2. On Error GoTo doctor
  3. Dim DeviceListLen As String
  4.     eilute = 0
  5.     'MSFlexGrid1
  6.    ReDim Preserve DeviceList(40)
  7.     ReDim Preserve DeviceFound(40)
  8.     DeviceListLen = 16
  9.     DeviceList = Array("Win32_FloppyDrive", "Win32_DiskDrive", "Win32_CDROMDrive", _
  10.                 "Win32_Processor", _
  11.                 "Win32_PhysicalMemory", _
  12.                 "Win32_SoundDevice", "Win32_SCSIController", "Win32_VideoController", _
  13.                 "Win32_Keyboard", _
  14.                 "Win32_PointingDevice", _
  15.                 "Win32_NetworkAdapter", "Win32_POTSModem", _
  16.                 "Win32_InfraredDevice", _
  17.                 "Win32_PCMCIAController", _
  18.                 "Win32_TapeDrive", _
  19.                 "Win32_PortableBattery")
  20.  
  21.  
  22.     strServer = txtUname
  23.     isconnect = ConnectTO("root\cimv2", _
  24.                    strUserName, _
  25.                    strPassword, _
  26.                    strServer, _
  27.                    objService)
  28.     If Not isconnect Then
  29.         MsgBox "Please check the server name, " _
  30.                         & "credentials and WBEM Core.", vbCritical,
  31.    
  32.     End If
  33.     DeviCecount = 0
  34.     For i = 0 To DeviceListLen - 1
  35.         Set objDeviceSet = objService.InstancesOf(DeviceList(i))
  36.         If objDeviceSet.Count <> 0 Then
  37.             DeviceFound(DeviCecount) = DeviceList(i)
  38.             DeviCecount = DeviCecount + 1
  39.             Call GetSndDevInfo(objService, DeviceList(i))
  40.             'MsgBox MSFlexGrid1.Rows
  41.        End If
  42.     Next
  43. Exit Sub
  44. doctor:
  45. MsgBox "Failed to access hardware information. Operation terminated.", vbCritical,
  46. End Sub


  1. '================
  2. Private Sub GetSndDevInfo(objService, strWBEMClass)
  3.  
  4.     On Error Resume Next
  5.        
  6.     ReDim Preserve oDeviceType(100)
  7.     ReDim Preserve oDeviceCaption(100)
  8.     ReDim Preserve oDeviceParam(100)
  9.     ReDim Preserve oDeviceInterf(100)
  10.    
  11.     Set objDeviceSet = objService.InstancesOf(strWBEMClass)
  12.     'MsgBox strWBEMClass
  13.    If objDeviceSet.Count <> 0 Then
  14.         For Each Device In objDeviceSet
  15.        
  16.     Select Case strWBEMClass
  17. ' ----------------------------------
  18.        Case "Win32_SoundDevice"
  19.             txtHW.Text = txtHW.Text & "Sound device:" & vbCrLf & Device.Caption & vbCrLf & vbCrLf
  20.             oDeviceType(eilute) = "Sound device"
  21.             oDeviceCaption(eilute) = Device.Caption
  22.             oDeviceParam(eilute) = ""
  23.             oDeviceInterf(eilute) = ""
  24.             eilute = eilute + 1
  25. ' -----------------------------------
  26.        Case "Win32_VideoController"
  27.             txtHW.Text = txtHW.Text & "Video controller:" & vbCrLf & Device.Caption & vbCrLf & "Memory: " & Device.AdapterRAM / 1048576 & " MB" & vbCrLf & vbCrLf
  28.             oDeviceType(eilute) = "Video controller"
  29.             oDeviceCaption(eilute) = Device.Caption
  30.             oDeviceParam(eilute) = Device.AdapterRAM / 1048576
  31.             oDeviceInterf(eilute) = ""
  32.             eilute = eilute + 1
  33. '----------------------------------
  34.        Case "Win32_NetworkAdapter"
  35.             If (Device.NetConnectionID = "Local Area Connection") And (Device.MACAddress <> "") Then
  36.                 txtHW.Text = txtHW.Text & "Network adapter:" & vbCrLf & Device.Caption & vbCrLf & Device.MACAddress & vbCrLf
  37.                 oDeviceType(eilute) = "Network adapter"
  38.                 oDeviceCaption(eilute) = Device.Caption
  39.                 oDeviceParam(eilute) = Device.MACAddress
  40.                 oDeviceInterf(eilute) = ""
  41.                 eilute = eilute + 1
  42.             End If
  43. ' ---------------------------------
  44.        Case "Win32_Keyboard"
  45.             txtHW.Text = txtHW.Text & "Keyboard:" & vbCrLf & Device.Description & vbCrLf & vbCrLf
  46.             oDeviceType(eilute) = "Keyboard"
  47.             oDeviceCaption(eilute) = Device.Description
  48.             oDeviceParam(eilute) = ""
  49.             oDeviceInterf(eilute) = ""
  50.             eilute = eilute + 1
  51. ' ---------------------------------
  52.        Case "Win32_PointingDevice"
  53.             txtHW.Text = txtHW.Text & "Pointing device/mouse:" & vbCrLf & Device.Caption & vbCrLf & PelesTipas(Device.PointingType) & vbCrLf & "Interface: " & PelesInt(Device.DeviceInterface) & vbCrLf & vbCrLf
  54.             oDeviceType(eilute) = "Pointing device/mouse:"
  55.             oDeviceCaption(eilute) = Device.Caption
  56.             oDeviceParam(eilute) = PelesTipas(Device.PointingType)
  57.             oDeviceInterf(eilute) = PelesInt(Device.DeviceInterface)
  58.             eilute = eilute + 1
  59. ' ----------------------------------
  60.        Case "Win32_DiskDrive"
  61.             txtHW.Text = txtHW.Text & "Harddisk:" & vbCrLf & Device.Description & vbCrLf & Device.Caption & vbCrLf & "Capacity: " & Device.Size / 1000000000 & " GB" & vbCrLf & "Interface: " & Device.InterfaceType & vbCrLf & vbCrLf
  62.             oDeviceType(eilute) = Device.Description
  63.             oDeviceCaption(eilute) = Device.Caption
  64.             oDeviceParam(eilute) = Device.Size
  65.             oDeviceInterf(eilute) = Device.InterfaceType
  66.             eilute = eilute + 1
  67. ' --------------------------------------
  68.        Case "Win32_CDROMDrive"
  69.             txtHW.Text = txtHW.Text & "CD ROM:" & vbCrLf & Device.Description & vbCrLf & "Drive letter: " & Device.Caption & vbCrLf & "Capacity: " & Device.Size / 1048576 & " MB" & vbCrLf & vbCrLf
  70.             oDeviceType(eilute) = Device.Description
  71.             oDeviceCaption(eilute) = Device.Caption
  72.             oDeviceParam(eilute) = Device.Size
  73.             oDeviceInterf(eilute) = ""
  74.             eilute = eilute + 1
  75. '------------------------------------------
  76.        Case "Win32_SCSIController"
  77.             txtHW.Text = txtHW.Text & "SCSI controller:" & vbCrLf & Device.Caption & vbCrLf & vbCrLf
  78.             oDeviceType(eilute) = "SCSI Controller"
  79.             oDeviceCaption(eilute) = Device.Caption
  80.             oDeviceParam(eilute) = ""
  81.             oDeviceInterf(eilute) = ""
  82.             eilute = eilute + 1
  83. ' -------------------------------------
  84.        Case "Win32_Processor"
  85.             txtHW.Text = txtHW.Text & "Processor/" & Device.Role & ":" & vbCrLf & Device.Name & vbCrLf & "Clock speed: " & Device.CurrentClockSpeed & vbCrLf & vbCrLf
  86.             oDeviceType(eilute) = Device.Role
  87.             oDeviceCaption(eilute) = Device.Name
  88.             oDeviceParam(eilute) = Device.CurrentClockSpeed
  89.             oDeviceInterf(eilute) = ""
  90.             eilute = eilute + 1
  91. ' -----------------------------------------
  92.        Case "Win32_PhysicalMemory"
  93.             txtHW.Text = txtHW.Text & Device.Description & ":" & vbCrLf & "Formfactor: " & ramas(Device.FormFactor) & vbCrLf & "Capacity: " & Device.Capacity / 1048576 & " MB" & vbCrLf & "Memory type: " & ramotipas(Device.MemoryType) & vbCrLf & vbCrLf
  94.             oDeviceType(eilute) = Device.Description
  95.             oDeviceCaption(eilute) = ramas(Device.FormFactor)
  96.             oDeviceParam(eilute) = Device.Capacity / 1048576
  97.             oDeviceInterf(eilute) = ramotipas(Device.MemoryType)
  98.             eilute = eilute + 1
  99. ' --------------------------------------
  100.        Case "Win32_FloppyDrive"
  101.             txtHW.Text = txtHW.Text & Device.Description & vbCrLf & Device.Caption & vbCrLf & Device.MaxMediaSize & vbCrLf & vbCrLf
  102.             oDeviceType(eilute) = Device.Description
  103.             oDeviceCaption(eilute) = Device.Caption
  104.             oDeviceParam(eilute) = Device.MaxMediaSize
  105.             oDeviceInterf(eilute) = ""
  106.             eilute = eilute + 1
  107. ' ------------------------------------
  108.        Case "Win32_POTSModem"
  109.             txtHW.Text = txtHW.Text & "POTS modem:" & vbCrLf & Device.Caption & vbCrLf & "Max baud rate to phone: " & Device.MaxBaudRateToPhone & vbCrLf & Device.Description & vbCrLf & vbCrLf
  110.             oDeviceType(eilute) = "POTS Modem"
  111.             oDeviceCaption(eilute) = Device.Caption
  112.             oDeviceParam(eilute) = Device.MaxBaudRateToPhone
  113.             oDeviceInterf(eilute) = Device.Description
  114.             eilute = eilute + 1
  115. ' ----------------------------------
  116.        Case "Win32_InfraredDevice"
  117.             txtHW.Text = txtHW.Text & "Infrared device:" & vbCrLf & Device.Caption & vbCrLf & vbCrLf
  118.             oDeviceType(eilute) = "Infrared Device"
  119.             oDeviceCaption(eilute) = Device.Caption
  120.             oDeviceParam(eilute) = ""
  121.             oDeviceInterf(eilute) = ""
  122.             eilute = eilute + 1
  123. '  ----------------------------------
  124.        Case "Win32_PCMCIAController"
  125.             txtHW.Text = txtHW.Text & "PCMCIA controller:" & vbCrLf & Device.Caption & vbCrLf & vbCrLf
  126.             oDeviceType(eilute) = "PCMCIA Controller"
  127.             oDeviceCaption(eilute) = Device.Caption
  128.             oDeviceParam(eilute) = ""
  129.             oDeviceInterf(eilute) = ""
  130.             eilute = eilute + 1
  131. '  -------------------------------------
  132.        Case "Win32_TapeDrive"
  133.             txtHW.Text = txtHW.Text & "Tape drive:" & vbCrLf & Device.Caption & vbCrLf & "Capacity: " & Device.MaxMediaSize & vbCrLf & Device.Description & vbCrLf & vbCrLf
  134.             oDeviceType(eilute) = "Tape Drive"
  135.             oDeviceCaption(eilute) = Device.Caption
  136.             oDeviceParam(eilute) = Device.MaxMediaSize
  137.             oDeviceInterf(eilute) = Device.Description
  138.             eilute = eilute + 1
  139. ' -----------------------------------
  140.        Case "Win32_PortableBattery"
  141.             txtHW.Text = txtHW.Text & "Portable battery:" & vbCrLf & Device.Caption & vbCrLf & Device.Chemistry & vbCrLf & vbCrLf
  142.             oDeviceType(eilute) = "Portable Battery"
  143.             oDeviceCaption(eilute) = Device.Caption
  144.             oDeviceParam(eilute) = ""
  145.             oDeviceInterf(eilute) = Device.Chemistry
  146.             eilute = eilute + 1
  147.     End Select
  148.     Next
  149.     End If
  150.  
  151. txtHW.Text = txtHW.Text & "========================================" & vbCrLf & vbCrLf
  152. End Sub


  1. Private Function ConnectTO(ByVal strNameSpace, _
  2.                             ByVal strUserName, _
  3.                             ByVal strPassword, _
  4.                             ByRef strServer, _
  5.                             ByRef objService)
  6.  
  7.     On Error Resume Next
  8.  
  9.     Dim objLocator, objWshNet
  10.  
  11.     ConnectTO = True     'Ko có lỗi sảy ra
  12.  
  13.     'Tạo đối tượng để kết nối tới CIM
  14.    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
  15.     If Err.Number Then
  16.         MsgBox "Error 0x" & CStr(Hex(Err.Number)) & _
  17.                            " occurred in creating a locator object.", vbCritical,
  18.         If Err.Description <> "" Then
  19.             MsgBox "Error description: " & Err.Description & ".", vbCritical,
  20.         End If
  21.         Err.Clear
  22.         ConnectTO = False     'Có lỗi
  23.        Exit Function
  24.     End If
  25.  
  26.     'Connect to the namespace which is either local or remote
  27.    Set objService = objLocator.ConnectServer(strServer, strNameSpace, _
  28.        strUserName, strPassword)
  29.     objService.Security_.impersonationlevel = 3
  30.     If Err.Number Then
  31.         MsgBox "Error 0x" & CStr(Hex(Err.Number)) & _
  32.                            " occurred in connecting to server " _
  33.            & strServer & ".", vbCritical, "Error"
  34.         If Err.Description <> "" Then
  35.             MsgBox "Error description: " & Err.Description & ".", vbCritical, "Error"
  36.         End If
  37.         Err.Clear
  38.         ConnectTO = False     'Xảy ra lỗi
  39.    End If
  40. End Function
  41.  


From
  1. Private Sub Command1_Click()
  2. Call scanhard
  3. End Sub
  4.  
  5. Private Sub Form_Load()
  6. 'Hardware scanner
  7.    eilute = 0
  8.     webUserName = ""
  9.     webPassword = ""
  10.     isClient = False
  11.     isClienta = False
  12.     klientoID = 0
  13.     ramas = Array("Unknown", "Other", "SIP", "DIP", "ZIP", "SOJ", "Proprietary", _
  14.                     "SIMM", "DIMM", "TSOP", "PGA", "RIMM", "SODIMM")
  15.                
  16.     ramotipas = Array("Unknown", "Other", "DRAM", "Synchronous DRAM", "Cache DRAM", _
  17.                     "EDO", "EDRAM", "VRAM", "SRAM", "RAM", "ROM", "Flash", "EEPROM", _
  18.                     "FEPROM", "EPROM", "CDRAM", "3DRAM", "SDRAM", "SGRAM")
  19.                    
  20. ReDim Preserve PelesInt(165)
  21. PelesInt(1) = "Other"
  22. PelesInt(2) = "Unknown"
  23. PelesInt(3) = "Serial"
  24. PelesInt(4) = "PS / 2"
  25. PelesInt(5) = "Infrared"
  26. PelesInt(6) = "HP - HIL"
  27. PelesInt(7) = "Bus mouse"
  28. PelesInt(8) = "ADB (Apple Desktop Bus)"
  29. PelesInt(160) = "Bus mouse DB-9"
  30. PelesInt(161) = "Bus mouse micro-DIN"
  31. PelesInt(162) = "USB"
  32.  
  33. ReDim Preserve PelesTipas(10)
  34. PelesTipas(1) = "Other"
  35. PelesTipas(2) = "Unknown"
  36. PelesTipas(3) = "Mouse"
  37. PelesTipas(4) = "Track Ball"
  38. PelesTipas(5) = "Track Point"
  39. PelesTipas(6) = "Glide Point"
  40. PelesTipas(7) = "Touch Pad"
  41.  
  42. Set objWshNet = CreateObject("Wscript.Network")
  43. txtUname = objWshNet.ComputerName
  44.  
  45. End Sub
  46.  
  47.  



Koha JeseMen
Thành viên chính thức
Thành viên chính thức
Bài viết: 24
Ngày tham gia: T.Ba 27/07/2010 9:00 pm
Has thanked: 5 time

Re: Lấy thông tin hardware

Gửi bàigửi bởi Koha JeseMen » T.Tư 27/04/2011 4:54 pm

Send Source luôn đi !
Lỗi ReDim Preserve DeviceList(40)

LV Phuoc
Bài viết: 1
Ngày tham gia: T.Hai 25/04/2011 10:29 pm
Has thanked: 1 time

Re: Lấy thông tin hardware

Gửi bàigửi bởi LV Phuoc » T.Tư 11/05/2011 10:18 pm

Up Source cho bạn :)

Mã: Chọn hết

http://www.mediafire.com/?0mqye8e5wj75p3k

otacon
Bài viết: 3
Ngày tham gia: T.Sáu 22/06/2012 5:51 pm

Re: Lấy thông tin hardware

Gửi bàigửi bởi otacon » T.Tư 27/06/2012 2:21 am

up lại đi bro ơi

Hình đại diện của người dùng
khoaakt
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 75
Ngày tham gia: T.Ba 19/06/2012 6:30 pm
Đến từ: http://việtnam.vn/Kontum/Trường/THPT Chuyên Nguyễn Tất Thành.htm
Has thanked: 8 time
Been thanked: 7 time
Liên hệ:

Re: Lấy thông tin hardware

Gửi bàigửi bởi khoaakt » T.Bảy 18/08/2012 5:19 pm

Tét code OK... f5..OK ra thế này...
Hình ảnh
cách khắc phục???

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

Re: Lấy thông tin hardware

Gửi bàigửi bởi dactung93 » T.Tư 22/08/2012 2:09 am

Bạn để thuộc tính textbox là multiline=true rồi scoll nữa


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách