سلام
با این کار میشه اطلاعات سخت افزاری زیادی رو از سیستم گرفت :
1-اول شما یه فرم و یه Module به پروژتون اضافه کنید
2-بع بر روی فرمتون یه کنترل ListboxوLabel و Command Button اضافه کنید
3-Module رو باز کنین و کد زیر رو وارد کنین :
Public isClient As Boolean
Public isClienta As Boolean
Public strUserName As String
Public strPassword As String
Public klientoID As Integer
Public webUserName As String
Public webPassword As String
Public oDeviceType() As Variant
Public oDeviceCaption() As Variant
Public oDeviceParam() As Variant
Public oDeviceInterf() As Variant
Public eilute As Integer
Public isHardware As Boolean
2-قسمت General فرم رو باز کنید و کد های زیر رو توش بنویسید :
Dim DeviceFound() As Variant
Dim DeviceList() As Variant
Dim DeviCecount As Integer
Dim ramas As Variant
Dim ramotipas As Variant
Dim PelesInt() As Variant
Dim PelesTipas() As Variant
Private Function ConnectTO(ByVal strNameSpace, _
ByVal strUserName, _
ByVal strPassword, _
ByRef strServer, _
ByRef objService)
On Error Resume Next
Dim objLocator, objWshNet
ConnectTO = True 'There is no error.
'Create Locator object to connect to remote CIM object manager
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
If Err.Number Then
MsgBox "Error 0x" & CStr(Hex(Err.Number)) & _
" occurred in creating a locator object."
If Err.Description <> "" Then
MsgBox "Error description: " & Err.Description & "."
End If
Err.Clear
ConnectTO = False 'An error occurred
Exit Function
End If
'Connect to the namespace which is either local or remote
Set objService = objLocator.ConnectServer(strServer, strNameSpace, _
strUserName, strPassword)
objService.Security_.impersonationlevel = 3
If Err.Number Then
MsgBox "Error 0x" & CStr(Hex(Err.Number)) & _
" occurred in connecting to server " _
& strServer & "."
If Err.Description <> "" Then
MsgBox "Error description: " & Err.Description & "."
End If
Err.Clear
ConnectTO = False 'An error occurred
End If
End Function
Private Sub GetSndDevInfo(objService, strWBEMClass)
On Error Resume Next
ReDim Preserve oDeviceType(100)
ReDim Preserve oDeviceCaption(100)
ReDim Preserve oDeviceParam(100)
ReDim Preserve oDeviceInterf(100)
Set objDeviceSet = objService.InstancesOf(strWBEMClass)
If objDeviceSet.Count <> 0 Then
For Each Device In objDeviceSet
Select Case strWBEMClass
' GARSAS----------------------------------
Case "Win32_SoundDevice"
List1.AddItem "Sound Device" & vbTab & Device.Caption & vbTab & "" & vbTab & ""
oDeviceType(eilute) = "Sound Device"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' VIDIO-----------------------------------
Case "Win32_VideoController"
List1.AddItem "Video Controller" & vbTab & Device.Caption & vbTab & Device.AdapterRAM / 1048576 & vbTab & ""
oDeviceType(eilute) = "Video Controller"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.AdapterRAM / 1048576
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' NETWORK----------------------------------
Case "Win32_NetworkAdapter"
If (Device.NetConnectionID = "Local Area Connection") And (Device.MACAddress <> "") Then
List1.AddItem "Network Adapter" & vbTab & Device.Caption & vbTab & Device.MACAddress & vbTab & ""
oDeviceType(eilute) = "Network Adapter"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.MACAddress
oDeviceInterf(eilute) = ""
eilute = eilute + 1
End If
' KEYBOARD---------------------------------
Case "Win32_Keyboard"
List1.AddItem "Keyboard" & vbTab & vbTab & Device.Description & vbTab & "" & vbTab & ""
oDeviceType(eilute) = "Keyboard"
oDeviceCaption(eilute) = Device.Description
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' MOUSE---------------------------------
Case "Win32_PointingDevice"
List1.AddItem "Pointing Device" & vbTab & Device.Caption & vbTab & PelesTipas(Device.PointingType) & vbTab & PelesInt(Device.DeviceInterface)
oDeviceType(eilute) = "Pointing Device"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = PelesTipas(Device.PointingType)
oDeviceInterf(eilute) = PelesInt(Device.DeviceInterface)
eilute = eilute + 1
' DISK----------------------------------
Case "Win32_DiskDrive"
List1.AddItem Device.Description & vbTab & Device.Caption & vbTab & Device.Size & vbTab & Device.InterfaceType
oDeviceType(eilute) = Device.Description
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.Size
oDeviceInterf(eilute) = Device.InterfaceType
eilute = eilute + 1
' CD-ROM--------------------------------------
Case "Win32_CDROMDrive"
List1.AddItem Device.Description & vbTab & Device.Caption & vbTab & Device.Size & vbTab & ""
oDeviceType(eilute) = Device.Description
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.Size
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' SCSI------------------------------------------
Case "Win32_SCSIController"
List1.AddItem "SCSI Controller" & vbTab & Device.Caption & vbTab & "" & vbTab & ""
oDeviceType(eilute) = "SCSI Controller"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' PROCESSOR-------------------------------------
Case "Win32_Processor"
List1.AddItem Device.Role & vbTab & vbTab & Device.Name & vbTab & Device.CurrentClockSpeed & vbTab & ""
oDeviceType(eilute) = Device.Role
oDeviceCaption(eilute) = Device.Name
oDeviceParam(eilute) = Device.CurrentClockSpeed
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' MEMORY-----------------------------------------
Case "Win32_PhysicalMemory"
List1.AddItem Device.Description & vbTab & ramas(Device.FormFactor) & vbTab & Device.Capacity / 1048576 & vbTab & ramotipas(Device.MemoryType)
oDeviceType(eilute) = Device.Description
oDeviceCaption(eilute) = ramas(Device.FormFactor)
oDeviceParam(eilute) = Device.Capacity / 1048576
oDeviceInterf(eilute) = ramotipas(Device.MemoryType)
eilute = eilute + 1
' FLOPYY--------------------------------------
Case "Win32_FloppyDrive"
List1.AddItem Device.Description & vbTab & Device.Caption & vbTab & Device.MaxMediaSize & vbTab & ""
oDeviceType(eilute) = Device.Description
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.MaxMediaSize
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' MODEM------------------------------------
Case "Win32_POTSModem"
List1.AddItem "POTS Modem" & vbTab & Device.Caption & vbTab & Device.MaxBaudRateToPhone & vbTab & Device.Description
oDeviceType(eilute) = "POTS Modem"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.MaxBaudRateToPhone
oDeviceInterf(eilute) = Device.Description
eilute = eilute + 1
' INFRARED----------------------------------
Case "Win32_InfraredDevice"
List1.AddItem "Infrared Device" & vbTab & Device.Caption & vbTab & "" & vbTab & ""
oDeviceType(eilute) = "Infrared Device"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' PCMCIA ----------------------------------
Case "Win32_PCMCIAController"
List1.AddItem "PCMCIA Controller" & vbTab & Device.Caption & vbTab & "" & vbTab & ""
oDeviceType(eilute) = "PCMCIA Controller"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = ""
eilute = eilute + 1
' TAPE -------------------------------------
Case "Win32_TapeDrive"
List1.AddItem "Tape Drive" & vbTab & Device.Caption & vbTab & Device.MaxMediaSize & vbTab & Device.Description
oDeviceType(eilute) = "Tape Drive"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = Device.MaxMediaSize
oDeviceInterf(eilute) = Device.Description
eilute = eilute + 1
' BATTERY-----------------------------------
Case "Win32_PortableBattery"
List1.AddItem "Portable Battery" & vbTab & Device.Caption & vbTab & "" & vbTab & Device.Chemistry
oDeviceType(eilute) = "Portable Battery"
oDeviceCaption(eilute) = Device.Caption
oDeviceParam(eilute) = ""
oDeviceInterf(eilute) = Device.Chemistry
eilute = eilute + 1
End Select
Next
End If
End Sub
Public Sub ScanH()
List1.Clear
label1.caption="Reading"
eilute = 0
ReDim Preserve DeviceList(40)
ReDim Preserve DeviceFound(40)
DeviceListLen = 16
DeviceList = Array("Win32_FloppyDrive", "Win32_DiskDrive", "Win32_CDROMDrive", _
"Win32_Processor", _
"Win32_PhysicalMemory", _
"Win32_SoundDevice", "Win32_SCSIController", "Win32_VideoController", _
"Win32_Keyboard", _
"Win32_PointingDevice", _
"Win32_NetworkAdapter", "Win32_POTSModem", _
"Win32_InfraredDevice", _
"Win32_PCMCIAController", _
"Win32_TapeDrive", _
"Win32_PortableBattery")
strServer = Text3
isconnect = ConnectTO("root\cimv2", _
strUserName, _
strPassword, _
strServer, _
objService)
If Not isconnect Then
MsgBox "Please check the server name, " _
& "credentials and WBEM Core."
End If
DeviCecount = 0
For i = 0 To DeviceListLen - 1
Set objDeviceSet = objService.InstancesOf(DeviceList(i))
If objDeviceSet.Count <> 0 Then
DeviceFound(DeviCecount) = DeviceList(i)
DeviCecount = DeviCecount + 1
Call GetSndDevInfo(objService, DeviceList(i))
End If
Next
label1.caption="Ready"
End Sub
4- بعد Form_load رو باز کنین و اینا رو اضافه کنین :
Private sub form_load()
eilute = 0
isClient = False
isClienta = False
klientoID = 0
ramas = Array("Unknown", "Other", "SIP", "DIP", "ZIP", "SOJ", "Proprietary", _
"SIMM", "DIMM", "TSOP", "PGA", "RIMM", "SODIMM")
ramotipas = Array("Unknown", "Other", "DRAM", "Synchronous DRAM", "Cache DRAM", _
"EDO", "EDRAM", "VRAM", "SRAM", "RAM", "ROM", "Flash", "EEPROM", _
"FEPROM", "EPROM", "CDRAM", "3DRAM", "SDRAM", "SGRAM")
ReDim Preserve PelesInt(165)
PelesInt(1) = "Other"
PelesInt(2) = "Unknown"
PelesInt(3) = "Serial"
PelesInt(4) = "PS / 2"
PelesInt(5) = "Infrared"
PelesInt(6) = "HP - HIL"
PelesInt(7) = "Bus mouse"
PelesInt(8) = "ADB (Apple Desktop Bus)"
PelesInt(160) = "Bus mouse DB-9"
PelesInt(161) = "Bus mouse micro-DIN"
PelesInt(162) = "USB"
ReDim Preserve PelesTipas(10)
PelesTipas(1) = "Other"
PelesTipas(2) = "Unknown"
PelesTipas(3) = "Mouse"
PelesTipas(4) = "Track Ball"
PelesTipas(5) = "Track Point"
PelesTipas(6) = "Glide Point"
PelesTipas(7) = "Touch Pad"
Set objWshNet = CreateObject("Wscript.Network")
end sub
5-حالا در قسمت Command_click اینا رو بنویسید :
private sub command1_click()
Call ScanH
end sub
6- خوب خسته نباشید .
حالا برنامه رو RUN کنید و وقتی که بر روی Command1 کلیک کنید توی لیست اسم و مشخصات بیشتر Hardware های سیستم رو لیست میکنه .
موفق باشید .
پاسخ با نقل قول
