pro_7.frm

是API教程4

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00E0E0E0&
   Caption         =   "Lesson_7"
   ClientHeight    =   4590
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6405
   LinkTopic       =   "Form1"
   ScaleHeight     =   4590
   ScaleWidth      =   6405
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   1
      Left            =   4800
      ScaleHeight     =   285
      ScaleWidth      =   1305
      TabIndex        =   5
      Top             =   3300
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   0
      Left            =   1680
      ScaleHeight     =   285
      ScaleWidth      =   1305
      TabIndex        =   4
      Top             =   3300
      Width           =   1335
   End
   Begin VB.CommandButton Command3 
      Caption         =   "系统声音"
      Height          =   315
      Left            =   480
      TabIndex        =   3
      Top             =   3900
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "重新启动"
      Height          =   315
      Left            =   3360
      TabIndex        =   2
      Top             =   3900
      Width           =   1515
   End
   Begin VB.CommandButton Command1 
      Caption         =   "系统信息"
      Height          =   315
      Left            =   1860
      TabIndex        =   1
      Top             =   3900
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      Height          =   2955
      Left            =   180
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "pro_7.frx":0000
      Top             =   180
      Width           =   5955
   End
   Begin VB.Label Label2 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Windows桌面颜色"
      Height          =   195
      Left            =   3240
      TabIndex        =   7
      Top             =   3360
      Width           =   1695
   End
   Begin VB.Label Label1 
      BackColor       =   &H00E0E0E0&
      Caption         =   "窗口标题栏颜色"
      Height          =   255
      Left            =   300
      TabIndex        =   6
      Top             =   3360
      Width           =   1755
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Const COLOR_ACTIVECAPTION& = 2
Private Const COLOR_BACKGROUND& = 1
Private Const EWX_REBOOT& = 2
Private Const PROCESSOR_INTEL_386& = 386
Private Const PROCESSOR_INTEL_486& = 486
Private Const PROCESSOR_INTEL_PENTIUM& = 586
Private Const PROCESSOR_MIPS_R4000& = 4000
Private Const MB_ICONASTERISK& = &H40&
Private Const MB_ICONEXCLAMATION& = &H30&
Private Const MB_ICONHAND& = &H10&
Private Const MB_ICONINFORMATION& = MB_ICONASTERISK
Private Const MB_ICONMASK& = &HF0&
Private Const MB_ICONQUESTION& = &H20&
Private Const MB_ICONSTOP& = MB_ICONHAND


Private Declare Function GetSysColor& Lib "user32" (ByVal nIndex As Long)
Private Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)
Private Declare Function GetComputerName& Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long)
Private Declare Function GetUserName& Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)
Private Declare Function MessageBeep& Lib "user32" (ByVal wType As Long)
Private Declare Function DestroyCaret& Lib "user32" ()


Private Sub Command1_Click()
    Dim dl&
    Dim strRetu As String * 256
    Dim ctr As String
    Dim strGet As String
    Dim sysInfo As SYSTEM_INFO
    Dim osInfo As OSVERSIONINFO
    
    ctr = Chr(13) & Chr(10)
    
     dl& = GetUserName(strRetu, 255)
        strGet = Left(strRetu, InStr(strRetu, Chr(0)) - 1)
        Text1.Text = "User name             ∶" & strGet & ctr
     
     dl& = GetComputerName(strRetu, 255)
        strGet = Left(strRetu, InStr(strRetu, Chr(0)) - 1)
        Text1.Text = Text1.Text & "Computer name         ∶" & strGet & ctr
        
        
     Text1.Text = Text1.Text & ctr & "--- System Info ---" & ctr
     GetSystemInfo sysInfo
      Text1.Text = Text1.Text & "OEM ID                ∶" & sysInfo.dwOemID & ctr
      Text1.Text = Text1.Text & "Page size             ∶" & sysInfo.dwPageSize & ctr
      Text1.Text = Text1.Text & "Lowest memory address ∶" & Hex$(sysInfo.lpMinimumApplicationAddress) & ctr
      Text1.Text = Text1.Text & "Highest memory address∶" & Hex$(sysInfo.lpMaximumApplicationAddress) & ctr
      Text1.Text = Text1.Text & "Active processor mask ∶" & sysInfo.dwActiveProcessorMask & ctr
      Text1.Text = Text1.Text & "Number of processors  ∶" & sysInfo.dwNumberOrfProcessors & ctr
      Text1.Text = Text1.Text & "Processor type        ∶"
      Select Case sysInfo.dwProcessorType
             Case PROCESSOR_INTEL_386
                  Text1.Text = Text1.Text & "Intel 386" & ctr
             Case PROCESSOR_INTEL_486
                  Text1.Text = Text1.Text & "Intel 486" & ctr
             Case PROCESSOR_INTEL_PENTIUM
                  Text1.Text = Text1.Text & "Pentium" & ctr
             Case PROCESSOR_MIPS_R4000
                  Text1.Text = Text1.Text & "MIPS R4000" & ctr
             Case Else
                  Text1.Text = Text1.Text & sysInfo.dwProcessorType & ctr
      End Select
      Text1.Text = Text1.Text & "Allocation Granularity∶" & sysInfo.dwAllocationGranularity & ctr
      
      Text1.Text = Text1.Text & ctr & "--- Os Info ---" & ctr
      osInfo.dwOSVersionInfoSize = Len(osInfo)
      GetVersionEx osInfo
           Text1.Text = Text1.Text & "Major version(主版本)   ∶" & osInfo.dwMajorVersion & ctr
           Text1.Text = Text1.Text & "Minor version(次版本)   ∶" & osInfo.dwMinorVersion & ctr
           Text1.Text = Text1.Text & "Build number (创建号)   ∶" & osInfo.dwBuildNumber & ctr
           Text1.Text = Text1.Text & "Plat form ID(平台标示符)∶" & osInfo.dwPlatformId & ctr
           Text1.Text = Text1.Text & "操作系统描述文件∶" & Left(osInfo.szCSDVersion, InStr(osInfo.szCSDVersion, Chr(0)) - 1) & ctr
           
      
      
End Sub

Private Sub Command2_Click()
    Dim msg As Integer

    msg = MsgBox("应用程序准备关闭计算机并从新启动！", vbOKCancel + vbExclamation, "警告")
    If msg = vbOK Then
        ExitWindowsEx EWX_REBOOT, 0
    End If
End Sub

Private Sub Command3_Click()

                MessageBeep MB_ICONASTERISK

End Sub

Private Sub Form_Load()
    Move (Screen.Width - Form1.Width) \ 2, (Screen.Height - Form1.Height) \ 2
    Text1.Locked = True
    Text1.Text = ""
    
    Picture1(0).BackColor = GetSysColor(COLOR_ACTIVECAPTION)
    Picture1(1).BackColor = GetSysColor(COLOR_BACKGROUND)
    
End Sub

Private Sub Text1_GotFocus()
    DestroyCaret
End Sub