VBA دىن پايدىلىنىپ كومپيۇتېر ئۇچۇرلىرىنى ئېلىش

mouse · ۋاقتى: 2014-6-27 21:35:33

پىروگراممىدا كومپيۇتېر ئۇچۇرلىرىنى ئېلىش دائىم لازىم بولىدىغان مەشغۇلاتلارنىڭ بىرى بولۇپ، كومپيىۇتېر ئۇچۇرلىرىنى ئېلىش ئۇسۇلىمۇ ھەرخىل بولىدۇ.تېمىدا سۆزلەنگىلى API فۇنكىسيەسى GetVersionEx دىن پايدىلىنىپVBA(PPT) دا كومپيۇتېر ئاساسلىق ئۇچۇرلىرىنى ئېلىش سۆزلەندى.بۇ مەزمۇننى بىر چاغلاردا توردىن چۈشۈرۈۋالغان ئوخشايمەن، ياخشى نەرسە مەخپىي قالمىسۇن دەپ بۇ يەرگە يوللىشىم.قىزىققان قېرىنداشلىرىمىزنىڭ مۇشۇنداق نەرسىلەرگە ئېھتىياجى بولسا چۈشۈرۈپ پايدىلىنىشىنى سورايمەن ھەم خاتالىق بولسا بولسا ۋاقتىدا مەلۇم قىلىپ قويساڭلار.

1.API فۇنكىسيەسى ۋە مۇناسىۋەتلىك ئۆزگەرگۈچىلەرنى ئېنىقلاش

Option Explicit 'toluq uchurlar
Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As LongLong
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
osName As String
End Type
Private Function GetWindowsVersion() As OSVERSIONINFO
Dim ver As OSVERSIONINFO
ver.dwOSVersionInfoSize = 148
GetVersionEx ver
With ver
Select Case .dwPlatformId
Case 1
Select Case .dwMinorVersion
Case 0
.osName = "Windows 95"
Case 10
.osName = "Windows 98"
Case 90
.osName = "Windows Mellinnium"
End Select
Case 2
Select Case .dwMajorVersion
Case 3
.osName = "Windows NT 3.51"
Case 4
.osName = "Windows NT 4.0"
Case 5
If .dwMinorVersion = 0 Then
.osName = "Windows 2000"
Else
.osName = "Windows XP"
End If
Case 6
.osName = "Windows 7"
Case 7
.osName = "Windows 8"
Case 8
.osName = "Windows 8.1"
End Select
.osName = "Windows 8.1"
Case Else
End Select
End With
GetWindowsVersion = ver
End Function

مەزمۇننى كۆچۈرۈۋېلىش

2.جەمئىي 5 كۇنۇپكا ئورۇنلاشتۇرۇپ تۆۋەندىكى كودلارنى ئايرىم-ئايرىم مۇناسىۋەلىك كۇنۇپكىلارغا يېزىڭ
بىرىنچى كۇنۇپكا كومپيۇتېر نامى،ئاساسىي تاختا تەرتىپ نۇمۇرى،CPU تەرتىپ نۇمۇرى ۋە تور كارتىسى MAC ئادرېسىنى ئالىدۇ.

Private Sub CommandButton1_Click()
Dim myStr As String, mywshnw, objWMIService
Set mywshnw = CreateObject("Wscript.Network")
MsgBox myStr & "kompyuter nami£º " & mywshnw.ComputerName
Dim colItems As Object, objItem As Object, wmi As Object
Set wmi = GetObject("WinMgmts:")
Set colItems = wmi.InstancesOf("Win32_BaseBoard")
For Each objItem In colItems
MsgBox "asasi taxta tertip numuri bolsa£º" + objItem.SerialNumber
Exit For
Next
Set colItems = Nothing
Set wmi = GetObject("WinMgmts:")
Set colItems = wmi.InstancesOf("Win32_Processor")
For Each objItem In colItems
MsgBox "CPUIDÊÇ£º" + objItem.ProcessorId
Exit For
Next
Set colItems = Nothing
Set wmi = GetObject("WinMgmts:")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapter WHERE ((MACAddress Is Not NULL) AND (Manufacturer <> 'Microsoft'))")
For Each objItem In colItems
MsgBox "tor kartisi MAC adrisi£º" + objItem.MACAddress
Exit For
Next
Set colItems = Nothing
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

ئىككىنچى كۇنۇپكا IP ئادرېس ۋە كومپيۇتېر مەشغۇلات سىستېمىسى بىت سانىنى ئالىدۇ.

Private Sub CommandButton2_Click()
Dim strComputer As String, wmi As Object, colIP As Object, IP As Object, i As Integer
strComputer = "."
Set wmi = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colIP = wmi.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IP In colIP
For i = LBound(IP.IPAddress) To UBound(IP.IPAddress)
MsgBox "IPadris£؛" & IP.IPAddress(i), vbInformation, IP.Description(i)
Next
Next
MsgBox "meshghulat sistimisi nami we neshiri:" & Application.OperatingSystem
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

ئۈچىنچى كۇنۇپكا كومپيۇتېر تولۇق ئۇچۇرىنى ئالىدۇ

Private Sub CommandButton3_Click()
Dim wmi, w, a, i, fso, f
Set wmi = GetObject("winmgmts:\\.\root\CIMV2")
Set w = wmi.ExecQuery("select * from win32_processor")
a = "CPUأû³ئ"
For Each i In w
a = a & vbCrLf & i.Name
Next
Set w = wmi.ExecQuery("select * from win32_ComputerSystem")
a = a & vbCrLf & vbCrLf & "ؤع´و´َذ،"
For Each i In w
a = a & vbCrLf & i.totalPhysicalMemory
Next
Set w = wmi.ExecQuery("select * from win32_DiskDrive")
a = a & vbCrLf & vbCrLf & "qattiq diska chongluqi"
For Each i In w
a = a & vbCrLf & i.Size
Next
Set w = wmi.ExecQuery("select * from win32_LogicalDisk where DriveType='3'")
a = a & vbCrLf & vbCrLf & "diska----chongluqi"
For Each i In w
a = a & vbCrLf & i.DeviceID & " ---- " & i.Size
Next
Set w = wmi.ExecQuery("select * from win32_NetworkAdapter")
a = a & vbCrLf & vbCrLf & "tor maslashturghuch"
For Each i In w
a = a & vbCrLf & i.ProductName
Next
Set w = wmi.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=True")
a = a & vbCrLf & vbCrLf & "MACadrisi"
For Each i In w
a = a & vbCrLf & i.MACAddress
Next
Set w = wmi.ExecQuery("select * from win32_VideoController")
a = a & vbCrLf & vbCrLf & "korsitish kortisi tipi----دش´و"
For Each i In w
a = a & vbCrLf & i.Name & " ---- " & i.AdapterRAM
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.opentextfile("xinxi.txt", 2, True)
MsgBox "kompyuter uchurliri£؛" & vbCrLf & vbCrLf & a
f.Close
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

تۆچىنچى كۇنۇپكا كومپيۇتېر نامىغا، سىستېما ھالىتىگە،بىت سانىغا، كومپيۇتېر ئىشلەپ چىقارغان شىركەت ۋە كومپيۇتېر تىپىغا ھۆكۈم قىلىدۇ.

Private Sub CommandButton4_Click()
Dim System, item, i As Integer
Set System = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
For Each item In System
MsgBox ("kompyuter nami: " & item.Name)
MsgBox ("haliti: " & item.Status)
MsgBox ("tipi: " & item.SystemType)
MsgBox ("ishlep chiqarghan zawut: " & item.Manufacturer)
MsgBox ("tipi: " & item.Model)
MsgBox ("ichki saqlighuch: " & item.totalPhysicalMemory \ 1024 \ 1024 & "MB")
MsgBox ("tor: " & item.domain)
MsgBox ("xizmet guruppisi" & item.Workgroup)
MsgBox ("hazirqi ishletkuchi: " & item.username)
MsgBox ("qozghilish haliti: " & item.BootupState)
MsgBox ("bu kompyuter gha tewe: " & item.PrimaryOwnerName)
MsgBox ("sistima tipi: " & item.CreationClassName)
MsgBox ("kompyuter tipi: " & item.Description)
For i = 0 To 1 'eger ikki meshghulat sistimisi qachilanghan bolsa
MsgBox ("qozghilish tizimliki" & i & ": " & item.SystemStartupOptions(i))
Next i
Next
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

بەشىنچى كۇنۇپكا مەشغۇلات سىستېمىسىغا ھۆكۈم قىلىدۇ.

Private Sub CommandButton5_Click()
Dim ver As OSVERSIONINFO
ver = GetWindowsVersion()
With ver
MsgBox "meshghulat sistimisi£؛" & .osName & vbCrLf & "neshiri£؛" & .dwMajorVersion & "." & .dwMinorVersion & vbCrLf & "Build£؛" & .dwBuildNumber & vbCrLf & "?£؛" & .dwPlatformId & vbCrLf & "Service Pack£؛" & .szCSDVersion
End With
End Sub

مەزمۇننى كۆچۈرۈۋېلىش

ھېسابات		ساقلاش	پارول قايتۇرىۋېلىش
پارول			تىزىملىتىش

مىكروبلوگ[ يېڭى | 24 سائەت | 7 كۈن | 30 كۈن ]

VBA دىن پايدىلىنىپ كومپيۇتېر ئۇچۇرلىرىنى ئېلىش

باھا سۆز