si.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmSystemInfo 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "获取驱动器信息"
   ClientHeight    =   5760
   ClientLeft      =   972
   ClientTop       =   1032
   ClientWidth     =   7980
   Icon            =   "SI.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5760
   ScaleWidth      =   7980
   Begin VB.CommandButton Command1 
      Caption         =   "退出程序"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   612
      Left            =   2760
      TabIndex        =   1
      Top             =   5040
      Width           =   2052
   End
   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          =   4932
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "SI.frx":000C
      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 + "驱动器 " + Drive + " :" + ENTER
        Text1.Text = Text1.Text + "驱动器类型        = " + Systeem.DriveType(Drive) + ENTER
        Text1.Text = Text1.Text + "磁盘总容量        = 没有装入光盘" + ENTER
        Text1.Text = Text1.Text + "空闲磁盘空间      = -" + ENTER
        Text1.Text = Text1.Text + "卷标              = -" + ENTER
        Text1.Text = Text1.Text + "序列号            = -" + ENTER
    
    Else
    ' If a disk was loaded, show all the information.
    
        Text1.Text = Text1.Text + ENTER + "驱动器 " + Drive + " :" + ENTER
        Text1.Text = Text1.Text + "驱动器类型        = " + Systeem.DriveType(Drive) + ENTER
        Text1.Text = Text1.Text + "磁盘总容量        = " + Systeem.PutPoints(TotalDiskSpace) + " Bytes" + ENTER
        Text1.Text = Text1.Text + "空闲磁盘空间      = " + Systeem.PutPoints(FreeDiskSpace) + " Bytes" + ENTER
        Text1.Text = Text1.Text + "卷标              = " + Systeem.VolumeLabel(Drive) + ENTER
        Text1.Text = Text1.Text + "序列号            = " + Systeem.SerialNumber(Drive) + ENTER
    
    End If

Next

End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()



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



Systeem.Drives Removable, Fixed, CDrom, Ram, Network




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

Text1.Text = Text1.Text + "软驱         = " + CStr(Removable) + ENTER
Text1.Text = Text1.Text + "硬盘         = " + CStr(Fixed) + ENTER
Text1.Text = Text1.Text + "光驱         = " + CStr(CDrom) + ENTER

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


End Sub