亟需抓取系统主要硬件信息，像鲁大师那样
急需抓取系统主要硬件信息，像鲁大师那样
急需抓取系统主要硬件信息，像鲁大师那样，如果实现的好，可以出一些费用酬谢（直接联系我谈价也行），着急啊！
我的QQ：7432122
鲁大师的下载地址：
http://dl.pconline.com.cn/download/51901-1.html
------解决方案--------------------
wmi.
查查，看你要抓什么。
这里什么都是免费的。
------解决方案--------------------
'这是一个获取系统主要信息的程序
'
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Dim sinfo As SYSTEM_INFO
Dim minfo As MEMORYSTATUS
Private Sub Combo1_Click()
Dim x As Long
Dim cl1 As Long
Dim cl2 As Long
Dim sec1 As Long
Dim byt1 As Long
Dim buff As String
buff = Combo1.Text + ":\"
x = GetDriveType(buff)
Select Case x
Case 2
Label1.Caption = "该驱动器是可移动驱动器"
Case 3
Label1.Caption = "该驱动器是固定驱动器"
Case 4
Label1.Caption = "该驱动器是网络驱动器"
Case 5
Label1.Caption = "该驱动器是CD-ROM驱动器"
Case 6
Label1.Caption = "该驱动器是RAMDISK驱动器"
Case Else
Label1.Caption = "该驱动器无效"
End Select
x = GetDiskFreeSpace(buff, sec1, byt1, cl1, cl2)
If x Then
cl1 = cl1 * sec1 * byt1
cl2 = cl2 * sec1 * byt1
Label2.Caption = "该驱动器总共容量 " + Format$(cl2, "##########0") + " 字节"
Label3.Caption = "该驱动器可用容量 " + Format$(cl1, "##########0") + " 字节"
Else
Label2.Caption = ""
Label3.Caption = ""
End If
End Sub
Private Sub Form_Load()
Dim x As Long
Dim buff As String
For i = 0 To 25
buff = Chr$(65 + i) + ":\"
x = GetDriveType(buff)
If x > 1 Then
Combo1.AddItem Chr$(65 + i)
End If
急需抓取系统主要硬件信息，像鲁大师那样，如果实现的好，可以出一些费用酬谢（直接联系我谈价也行），着急啊！
我的QQ：7432122
鲁大师的下载地址：
http://dl.pconline.com.cn/download/51901-1.html
------解决方案--------------------
wmi.
查查，看你要抓什么。
这里什么都是免费的。
------解决方案--------------------
'这是一个获取系统主要信息的程序
'
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Dim sinfo As SYSTEM_INFO
Dim minfo As MEMORYSTATUS
Private Sub Combo1_Click()
Dim x As Long
Dim cl1 As Long
Dim cl2 As Long
Dim sec1 As Long
Dim byt1 As Long
Dim buff As String
buff = Combo1.Text + ":\"
x = GetDriveType(buff)
Select Case x
Case 2
Label1.Caption = "该驱动器是可移动驱动器"
Case 3
Label1.Caption = "该驱动器是固定驱动器"
Case 4
Label1.Caption = "该驱动器是网络驱动器"
Case 5
Label1.Caption = "该驱动器是CD-ROM驱动器"
Case 6
Label1.Caption = "该驱动器是RAMDISK驱动器"
Case Else
Label1.Caption = "该驱动器无效"
End Select
x = GetDiskFreeSpace(buff, sec1, byt1, cl1, cl2)
If x Then
cl1 = cl1 * sec1 * byt1
cl2 = cl2 * sec1 * byt1
Label2.Caption = "该驱动器总共容量 " + Format$(cl2, "##########0") + " 字节"
Label3.Caption = "该驱动器可用容量 " + Format$(cl1, "##########0") + " 字节"
Else
Label2.Caption = ""
Label3.Caption = ""
End If
End Sub
Private Sub Form_Load()
Dim x As Long
Dim buff As String
For i = 0 To 25
buff = Chr$(65 + i) + ":\"
x = GetDriveType(buff)
If x > 1 Then
Combo1.AddItem Chr$(65 + i)
End If