sysinfor.bas

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

Attribute VB_Name = "Sysinfor"
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'访问内存

Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public 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
Public Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
'  dwMajorVersion As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
'获得CUP信息
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Private Const max_path = 260

Public Function get_computername() As String
Dim name As String
Dim length As Long
length = 255
name = String(length, 0)
GetComputerName name, length
name = Left(name, length)
get_computername = name

End Function


Public Function sysinfo() As String
Dim sys As SYSTEM_INFO
Dim m As MEMORYSTATUS
Dim v As OSVERSIONINFO
Dim vname$, fsname$, strsave$, tmp$, tcd As String * 30
Dim serial As Long

''''''''''''''''''''''''''获取系统分区
Dim chrlen     As Long
Dim windir     As String
windir = Space(max_path)
      chrlen = GetWindowsDirectory(windir, max_path)
      If chrlen > max_path Then chrlen = GetWindowsDirectory(windir, chrlen)
      windir = Left$(windir, 1)
'''''''''''''''''''''''


'内存情况
GlobalMemoryStatus m
'版本信息
v.dwOSVersionInfoSize = Len(v)
GetVersionEx v
vname = Space(255)
fsname = Space(255)
'获得容量
GetVolumeInformation windir + ":\", vname, 255, serial, 0, 0, fsname, 255
'vname = stripnulls(vname)
'fsname = stripnulls(fsname)
tmp = Space(255)
'获得所有驱动器信息
GetLogicalDriveStrings 255, tmp
For a = Asc("a") To Asc("z")
If InStr(tmp, Chr(a) & ":\") Then
strsave = strave & IIf(stsave > "", ",", "") & Chr(a)
End If
Next a
'获得CPU信息
GetSystemInfo sys
'返回信息
s = "        " + "主机名称:" + " " + get_computername & vbCrLf
s = s & vbCrLf & "物理内存大小为：" & m.dwTotalPhys \ 1024 ^ 2 & "MB"
s = s & vbCrLf & "可用的物理内存大小为：" & m.dwAvailPhys \ 1024 ^ 2 & "MB"
s = s & vbCrLf & "虚拟内存大小为：" & m.dwTotalVirtual \ 1024 ^ 2 & "MB"
s = s & vbCrLf & "可用的虚拟内存大小为：" & m.dwAvailVirtual \ 1024 ^ 2 & "MB"
s = s & vbCrLf & "已用的物理内存大小为：" & (m.dwTotalPhys - m.dwAvailPhys) \ 1024 ^ 2 & "MB"
s = s & vbCrLf & vbCrLf & "系统版本号为：" & v.dwMajorVersion & "." & v.dwMinorVersion
s = s & vbCrLf & "系统类型 ：" & IIf(v.dwPlatformId = 1, "95/98/me", "NT/2000/XP/2003")
s = s & vbCrLf & vbCrLf & "处理器类型：" & sys.dwProcessorType
s = s & vbCrLf & "处理器序号：" & sys.dwNumberOfProcessors
s = s & vbCrLf & vbCrLf & "鼠标的按钮个数为：" & GetSystemMetrics(43)

s = s & vbCrLf & vbCrLf & "系统所在的分区：" + windir + ":"
s = s & vbCrLf & "系统分区的文件系统：" & fsname
s = s & vbCrLf & "系统分区的卷标名为：" & vname
s = s & vbCrLf & "系统分区的序列号为：" & serial
s = s & vbCrLf & "其它分区：" & strsave
sysinfo = s




End Function

Function fxinfo() As String
Dim volname As String, fsys As String, erg As Long
Dim volnumber As Long, mcm As Long, fsf As Long
Dim drive As String, drivetype As Long, s As String

''''''''''''''''''''''''''获取系统分区
Dim chrlen     As Long
Dim windir     As String
windir = Space(max_path)
      chrlen = GetWindowsDirectory(windir, max_path)
      If chrlen > max_path Then chrlen = GetWindowsDirectory(windir, chrlen)
      windir = Left$(windir, 1)
'''''''''''''''''''''''

volname = Space(127)

drive = windir + ":\"
drevetype& = GetDriveType(drive$)
erg& = GetVolumeInformation(drive$, volname$, 127&, volnumber&, mcm&, fsf&, fsys$, 127&)

s = "系统分区：" + windir + ":"
s = s & vbCrLf & "系统分区序列号：" & vbTab & volnumber
s = s & vbCrLf & "最大文件名称长：" & vbTab & mcm
s = s & vbCrLf & "文件系统标志： " & vbTab & fsf
s = s & vbCrLf & "文件系统名称：" & vbTab & fsys
s = s & vbCrLf & "分区名称：" & vbTab & volname
fxinfo = s

End Function