si.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmSystemInfo 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "System Information"
   ClientHeight    =   6276
   ClientLeft      =   972
   ClientTop       =   1032
   ClientWidth     =   7980
   Icon            =   "SI.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6276
   ScaleWidth      =   7980
   Begin VB.TextBox Text1 
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   6255
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "SI.frx":0442
      Top             =   0
      Width           =   7935
   End
End
Attribute VB_Name = "frmSystemInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Some variables to obtain the system information

Dim Systeem As New System   ' Systeem is Dutch for System
Dim Drive As String
Dim Percent As Byte
Dim Free As Long
Dim Total As Long
Dim Processor As String
Dim Number As Long
Dim Active As Long
Dim Maj As Integer
Dim Min As Integer
Dim Version As String
Dim TotalDiskSpace As Long
Dim FreeDiskSpace As Long
Dim ENTER As String

Dim Removable As Integer
Dim Fixed As Integer
Dim Ram As Integer
Dim Network As Integer
Dim CDrom As Integer

Private Declare Function apiGetDrives Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Sub Drives()

Dim Retrn As Long
Dim Buffer As Long
Dim Temp As String
Dim intI As Integer
Dim Read(1 To 100) As String
Dim Counter As Integer

Buffer = 10

' This first part is copied from the function Drives in the Class system
' so for the explanation, see the Drives function.

Again:
Temp = Space$(Buffer)
Retrn = apiGetDrives(Buffer, Temp)

If Retrn > Buffer Then
    Buffer = Retrn
    GoTo Again
End If

' The API returns something like :
' A:\*B:\*C:\*D:\**  , with  * = NULL character
' 1234123412341234
' \ 1 \ 2 \ 3 \ 4 \
'
' So we start reading three characters, we step 4 further (the three we read + the
' NULL-character), and we read again three characters, step 4, ect.

Counter = 0
For intI = 1 To (Buffer - 4) Step 4
    Counter = Counter + 1
    Read(Counter) = Mid$(Temp, intI, 3)   ' Read all the drives into this array
Next                                      ' Now this array contains all the drives
                                          ' so we can check them all out.



For intI = 1 To Counter
' Change the Drive to all the drives we have stored in the array.
' Now we can show information about all the drives in your computer.
    
    Drive = Read(intI)
    Systeem.DriveInfo Drive, TotalDiskSpace, FreeDiskSpace
    

    If TotalDiskSpace = 0 Then
    'No disk was loaded! Show nothing
    
        Text1.Text = Text1.Text + ENTER + "Disk " + Drive + " :" + ENTER
        Text1.Text = Text1.Text + "Drive Type        = " + Systeem.DriveType(Drive) + ENTER
        Text1.Text = Text1.Text + "Total disk space  = No disk loaded" + ENTER
        Text1.Text = Text1.Text + "Free disk space   = -" + ENTER
        Text1.Text = Text1.Text + "Volumelabel       = -" + ENTER
        Text1.Text = Text1.Text + "Serial Number     = -" + ENTER
    
    Else
    ' If a disk was loaded, show all the information.
    
        Text1.Text = Text1.Text + ENTER + "Disk " + Drive + " :" + ENTER
        Text1.Text = Text1.Text + "Drive Type        = " + Systeem.DriveType(Drive) + ENTER
        Text1.Text = Text1.Text + "Total disk space  = " + Systeem.PutPoints(TotalDiskSpace) + " Bytes" + ENTER
        Text1.Text = Text1.Text + "Free disk space   = " + Systeem.PutPoints(FreeDiskSpace) + " Bytes" + ENTER
        Text1.Text = Text1.Text + "Volumelabel       = " + Systeem.VolumeLabel(Drive) + ENTER
        Text1.Text = Text1.Text + "Serial Number     = " + Systeem.SerialNumber(Drive) + ENTER
    
    End If

Next

End Sub
Private Sub Form_Load()



ENTER = Chr$(13) + Chr$(10)


' Call some of the function that return values in variables
Systeem.FreeMemory Percent, Total, Free
Systeem.SystemInfo Processor, Number, Active
Systeem.Drives Removable, Fixed, CDrom, Ram, Network
Systeem.WinVer Maj, Min, Version



' Cstr convert values into a string
Text1.Text = ""

Text1.Text = Text1.Text + "Operating System     = " + Version + ENTER
Text1.Text = Text1.Text + "Windows version      = " + CStr(Maj) + "." + CStr(Min) + ENTER
Text1.Text = Text1.Text + "User name            = " + Systeem.UserName + ENTER

Text1.Text = Text1.Text + "Windows Directory    = " + Systeem.WinDir + ENTER
Text1.Text = Text1.Text + "System Directory     = " + Systeem.SystemDir + ENTER
Text1.Text = Text1.Text + "Temp Directory       = " + Systeem.TempDir + ENTER

Text1.Text = Text1.Text + "Keyboard Type        = " + Systeem.KeyboardType + ENTER
Text1.Text = Text1.Text + "Functionkeys         = " + CStr(Systeem.FunctionKeys) + ENTER

Text1.Text = Text1.Text + "Computername         = " + Systeem.ComputerName + ENTER
Text1.Text = Text1.Text + "Number of Processors = " + CStr(Number) + ENTER
Text1.Text = Text1.Text + "Active Processor     = #" + CStr(Active) + ENTER
Text1.Text = Text1.Text + "Processor Type       = " + Processor + ENTER
Text1.Text = Text1.Text + "Total RAM            = " + CStr(Total) + " Kb" + ENTER
Text1.Text = Text1.Text + "Free RAM             = " + CStr(Free) + " Kb" + ENTER
Text1.Text = Text1.Text + "RAM used             = " + CStr(Percent) + " %" + ENTER + ENTER
Text1.Text = Text1.Text + "Removable drives     = " + CStr(Removable) + ENTER
Text1.Text = Text1.Text + "Fixed drives         = " + CStr(Fixed) + ENTER
Text1.Text = Text1.Text + "CD-ROM drives        = " + CStr(CDrom) + ENTER
Text1.Text = Text1.Text + "RAM drives           = " + CStr(Ram) + ENTER
Text1.Text = Text1.Text + "Network drives       = " + CStr(Network) + ENTER

' Call the sub Drives (this is a sub of this form, not of the class)
Drives


End Sub