当前位置:DOS资源站资料中心VBS脚本 → VBScript,调查驱动器信息

VBScript,调查驱动器信息

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2008-4-5 0:06:08

Option Explicit
Dim objFSO, objWSH, objTxT, DriveCol
Dim Drive, Counter, TableContent, WholeLen, Show
ReDim Property(9), Table(9,1)
Counter=0
WholeLen=0
TableContent=""
Property(0)="    Drive Letter:"
Property(1)="     Is It Ready:"
Property(2)="      Drive Type:"
Property(3)="   Serial Number:"
Property(4)="     Volume Name:"
Property(5)="      Share Name:"
Property(6)="     File System:"
Property(7)="      Total Size:"
Property(8)="      Free Space:"
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objWSH=CreateObject("WScript.Shell")
Set objTxT=objFSO.CreateTextFile("DriveList.tXt")
Set DriveCol=objFSO.Drives
ReDim Table(9,DriveCol.Count)

For Each Drive in DriveCol
  If Drive.IsReady=False Then
          WScript.Sleep 1000
  End If
  With Drive
       Table(0,Counter)=.DriveLetter
       Table(1,Counter)=.IsReady
       Table(2,Counter)=.DriveType
    If Drive.IsReady=True Then
       Table(3,Counter)=.SerialNumber
       Table(4,Counter)=.VolumeName
       Table(5,Counter)=.ShareName
       Table(6,Counter)=.FileSystem
       Table(7,Counter)=.TotalSize
       Table(8,Counter)=.FreeSpace
    Else
       On Error Resume Next
    End If
  End With
  On Error GoTo 0
  Counter=Counter+1
Next

Explain

Padding

Show=Show & ";Generated by 'DriveLister' version 0.1.  'MBE Player' Releashed it as a FreeWare but ALL RIGHTS RESERVED." & vbCrLf & ";" & vbCrLf
Show=Show & ";Table: Information of Drives on Local Machine (" & DateValue(Date) & " " & TimeValue(Time) & ")" & vbCrLf
Show=Show & " " & String(WholeLen+18,"=") & vbCrLf

MakeTable

Show=Show & TableContent

objWSh.Run "DriveList.txt"

objTxT.Write(Show)
objTxT.Close
Set objWSH=Nothing
Set objFSO=Nothing
WScript.Quit

Sub Explain
  Dim i, DriveType
  DriveType=Split("Unknown;Removable;Fixed;Network;CD-ROM;RAM Disk",";")
  For i=0 To Counter-1
    Select Case Table(1,i)
      Case True
        Table(1,i)="Yes"
      Case False
        Table(1,i)="No"
      Case Else
    End Select
  Table(2,i)=DriveType(Table(2,i))
  If Table(5,i)="" Then
          Table(5,i)="?"
  End If
  If Not IsEmpty(Table(7,i)) Then
          Table(7,i)=Mask(Table(7,i))
  End If
  If Not IsEmpty(Table(8,i)) Then
          Table(8,i)=Mask(Table(8,i))
  End If
  Next
End Sub


Function Mask(Number)
  Dim Check, Subscript
  Check=Split("bytes;kB;MB;GB;TB",";")
  Subscript=0
    Do While Number>1024
      Number=Number/1024
      Subscript=Subscript+1
    Loop
  Number=Mid(Number,1,4)
  If InStr(";" & Number,".")=5 Then
    Mask=Left(Number,3) & "  " & Check(Subscript)
  Else
    Mask=Number & "  " & Check(Subscript)
  End If
End Function


Sub Padding
  Dim i, j, k, MaxLength
  For i=0 To Counter-1
  MaxLength=5
  For j=2 To 7
    If MaxLength<Len(Table(j,i)) Then
       MaxLength=Len(Table(j,i))
    End If
  Next
  For k=0 To 8
    If Len(Table(k,i))<MaxLength Then
             Table(k,i)=Table(k,i) & Space(MaxLength-Len(Table(k,i)))
    End If
  Next
  WholeLen=WholeLen+MaxLength+3
  Next
End Sub


Sub MakeTable
  Dim i, j, Line
  For i=0 To 8
    Line=Property(i)
    For j=0 To Counter-1
      Line=Line & Space(3) & Table(i,j)
    Next
   If i=0 Then
            Line=Line & vbCrLf & " " & String(WholeLen+18,"-")
    End If
    If i=8 Then
            Line=Line & vbCrLf & " " & String(WholeLen+18,"=")
    End If
    TableContent=TableContent & Line & vbCrLf
  Next
End Sub