Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformID As Long
    szCSDVersion As String * 128
End Type
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
Dim OSInfo As OSVERSIONINFO

''''*** 获取显示器等资源信息
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
''''***获取计算机名称
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

''''***获取磁盘剩余空间
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

''''***获取内存状况
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
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
Dim lpInfoBuffer As MEMORYSTATUS
Dim hdesktopwnd
Dim hdccaps

Public Sub DeviceInfo()
   
    Dim DisplayBits
    Dim DisplayPlanes
    Dim DisplayWidth
    Dim DisplayHeight
    Dim RetVal
    ''''获取窗口的设备场景
    hdccaps = GetDC(hdesktopwnd)
   
    ''''像素
    DisplayBits = GetDeviceCaps(hdccaps, 12)

    ''''
    DisplayPlanes = GetDeviceCaps(hdccaps, 14)

    ''''以像素为单位的显示宽度
    DisplayWidth = GetDeviceCaps(hdccaps, 8)

    ''''以像素为单位的显示高度
    DisplayHeight = GetDeviceCaps(hdccaps, 10)
   
    ''''释放由调用GetDC函数获取的指定设备场景
    RetVal = ReleaseDC(hdesktopwnd, hdccaps)
    ''''确定颜色数

If DisplayBits = 1 Then
If DisplayPlanes = 1 Then

    ''''黑白模式
    lblRes = "1 位/2 黑白模式"

    ElseIf DisplayPlanes = 4 Then

    ''''16色模式
    lblRes = "4 位/16 色"
End If

ElseIf DisplayBits = 8 Then

    ''''256色模式
   
    lblRes = "8 位/256 色"
ElseIf DisplayBits = 16 Then
   ''''真彩色16位模式
    lblRes = "真彩色16位/65,000 色"
ElseIf DisplayBits = 32 Then
   ''''真彩色32位模式
    lblRes = "真彩色32位/16,000,000 色"
Else
    ''''未知模式
    lblRes = "未知模式"

End If

End Sub

Function sGetComputerName() As String
  Dim sBuffer As String
  Dim lBufSize As Long
  Dim lStatus As Long
 
  lBufSize = 255
  sBuffer = String$(lBufSize, " ")
  lStatus = GetComputerName(sBuffer, lBufSize)
  sGetComputerName = ""
  If lStatus <> 0 Then
     sGetComputerName = Left(sBuffer, lBufSize)
  End If
  Form1.lblName = sGetComputerName
 
End Function
Public Function DiskSpace(DrivePath As String) As Double
'''' 通过驱动器符号获取它的剩余空间
  Dim Drive As String
  Dim SectorsPerCluster As Long, BytesPerSector As Long
  Dim NumberOfFreeClusters As Long, TotalClusters As Long, Sts As Long
  Dim DS

  Drive = Left(Trim(DrivePath), 1) & ":\"     ''''确认位于根目录
  Sts = GetDiskFreeSpace(Drive, SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalClusters)
  If Sts <> 0 Then
    DiskSpace = SectorsPerCluster * BytesPerSector * NumberOfFreeClusters
    DS = Format$(DiskSpace, "###,###")
    lblSpace = DS & " bytes"
  Else
    DiskSpace = -1        ''''出错将调用GetLastError
  End If
End Function

Private Sub Command1_Click()
 Unload Me
End Sub

Private Sub Form_Load()

''''计算机名称
Dim a
a = sGetComputerName
Dim OSName As String
''''操作系统版本
Dim RetVal As Long
RetVal = GetVersionEx(OSInfo)
OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space(128)
RetVal = GetVersionEx(OSInfo)
Select Case OSInfo.dwPlatformID
       Case VER_PLATFORM_WIN32s
            OSName = "Windows 3.1"
       Case VER_PLATFORM_WIN32_WINDOWS
            OSName = "Windows 98"
       Case VER_PLATFORM_WIN32_NT
            OSName = "Windows NT"
End Select
lblVersion.Caption = OSName & "(" & OSInfo.dwMajorVersion & "." & OSInfo.dwMinorVersion & ")"

Dim X As Variant
X = DiskSpace("c")

Call DeviceInfo

End Sub

Private Sub Timer1_Timer()
''''系统时间
lblTime.Caption = Time

''''内存
lpInfoBuffer.dwLength = Len(lpInfoBuffer)
GlobalMemoryStatus lpInfoBuffer
lblUsedMem.Caption = lpInfoBuffer.dwMemoryLoad & " % used"
lblTotalPhys.Caption = lpInfoBuffer.dwTotalPhys / 1024 & " KByte"
lblAvailPhys.Caption = lpInfoBuffer.dwAvailPhys / 1024 & " KByte"
lblTotalPageFile.Caption = lpInfoBuffer.dwTotalPageFile / 1024 & " KByte"
lblAvailPageFile.Caption = lpInfoBuffer.dwAvailPageFile / 1024 & " KByte"
lblTotalVirt = lpInfoBuffer.dwTotalVirtual / 1024 & " KByte"
lblAvailVirt = lpInfoBuffer.dwAvailVirtual / 1024 & " KByte"

''''日期
Dim day As String
Dim n As Integer
n = Weekday(Date)
If n = 1 Then day = "Sunday"
If n = 2 Then day = "Monday"
If n = 3 Then day = "Tuesday"
If n = 4 Then day = "Wednesday"
If n = 5 Then day = "Thursday"
If n = 6 Then day = "Friday"
If n = 7 Then day = "Saturday"
lblDate.Caption = day & ", " & Date

End Sub