刚接下了一个新的客户，由于之前没有专人维护，导致他的公司IT管理十分混乱。缺少IT信息档案，网络也处于不可控状态。于是先进行电脑巡检，记录每台电脑配置信息，以此为基础，摸清网络拓扑。

把下边的脚本文件放到一个可读写的共享目录中，然后在其它电脑上打开共享文件，运行脚本即可。这样就省去了手写录入信息的麻烦。

Name = Inputbox("请输入责任人姓名，请如实填写！","PC信息收集器","")
  If Name = "" then
  Wscript.Echo "未输入责任人姓名或自动取消！"
  Wscript.Quit
  End If
bumen = Inputbox("请输入所在部门，请如实填写！ ","PC信息收集器","")
  If bumen = "" then
  Wscript.Echo "未输入所在部门或自动取消！"
  Wscript.Quit
End If
yewu = Inputbox("请输入主要业务，请如实填写！ ","PC信息收集器","")
  If yewu = "" then
  Wscript.Echo "未输入主要业务或自动取消！"
  Wscript.Quit
End If
On Error Resume Next
  SerVerPath = ".\硬件信息"
  '这里的保存路径可以为UNC网络路径(\\path\)
  set wshshell=wscript.createobject("wscript.shell")
  '启动WMI服务
  wshshell.run ("%comspec% /c regsvr32 /s scrrun.dll"),0,True
  wshshell.run ("%comspec% /c sc config  winmgmt start= auto"),0,True
  wshshell.run ("%comspec% /c net start winmgmt"),0
  'wshshell.run ("%comspec% /c if not exist .\硬件信息 mkdir .\硬件信息"),0,True
  Dim objWMIService
  Set objWMIService = Getobject("winmgmts:\\.\root\cimv2")
  Dim objOSInfos, objOSInfo, OSInfo, ComputerName, OSVer
  Set objOSInfos = objWMIService.execQuery("Select * From win32_operatingsystem")
  For Each objOSInfo In objOSInfos
    OSInfo = objOSInfo.CSName & ","
    ComputerName = objOSInfo.CSName
    OSVer = objOSInfo.Version
    OSInfo = OSInfo & objOSInfo.Caption & " " & objOSInfo.CSDVersion & ","
    OSInfo  = OSInfo & Mid(CStr(objOSInfo.InstallDate),1,4) & "-" & _
              Mid(CStr(objOSInfo.InstallDate),5,2) & "-" & _
              Mid(CStr(objOSInfo.InstallDate),7,2) 
  Next
  
  Dim objBoards, objBoard, BoardInfo
  Set objBoards = objWMIService.execQuery("Select * From Win32_BaseBoard")
  For each objBoard In objBoards
    BoardInfo = Trim(objBoard.Product) & " "
    BoardInfo = BoardInfo & Trim(objBoard.Manufacturer) 
  Next
  
  Dim objCPUs, objCPU, CPUInfo
  Set objCPUs = objWMIService.execQuery("Select * From win32_processor")
  For each objCPU In objCPUs
    CPUInfo = Trim(objCPU.Name) & " "
	CPUInfo = Replace(CPUInfo,",","")
    'CPUInfo = CPUInfo & objCPU.ExtClock & " "
    'CPUInfo = CPUInfo & objCPU.L2CacheSize & " "
    CPUInfo = CPUInfo & objCPU.SocketDesignation 
  Next
  
  Dim objMemorys, objMemory, MemoryInfo
  Set objMemorys = objWMIService.execQuery("Select * From Win32_PhysicalMemory")
  Redim arrMemory(1)
  For Each objMemory In objMemorys
    arrMemory(0) = arrMemory(0) + objMemory.capacity/1048576
    arrMemory(1) = arrMemory(1) & objMemory.Speed & "MHz " & objMemory.DeviceLocator & " "
  Next
  MemoryInfo =  "共" & objMemorys.Count  & "根 /共" & arrMemory(0) & "M   " & arrMemory(1) 
  
  Dim objDisks, objDisk, DiskInfo
  Set objDisks = objWMIService.execQuery("Select * From win32_diskdrive")
  For Each objDisk In objDisks
    DiskInfo = Trim(objDisk.Model)
    Exit For
  Next
  
  Dim objVideos, objVideo, VideoInfo
  Set objVideos = objWMIService.execQuery("Select * From win32_videocontroller")
  For Each objVideo In objVideos
    If Not IsNull(objVideo.VideoModeDescription) Then
        VideoInfo = Trim(objVideo.Description)
        VideoInfo =  VideoInfo & "(" & objVideo.AdapterRAM/1048576 & "M 显存)"
    End If
Next
  
  Dim objNetworks, objNetwork, objNetworks_2, objNetwork_2, NetWorkInfo, DHCPInfo
  NetWorkInfo = ""
  Set objNetworks = objWMIService.execQuery("Select * From Win32_NetworkAdapter")
  Set objNetworks_2 = objWMIService.execQuery("Select * From Win32_NetworkAdapterConfiguration")
  For Each objNetwork In objNetworks
    If objNetwork.Manufacturer <> "Microsoft" And Not Isnull(objNetwork.MACAddress) Then
      For Each objNetwork_2 In objNetworks_2
        If objNetwork_2.Index = objNetwork.Index Then
          NetWorkInfo = objNetwork_2.IPAddress(0) & _
                        Space(17-Len(objNetwork_2.IPAddress(0))) & "," & _
                        Replace(objNetwork_2.MACAddress,":","-") 
          Exit For
        End If
      Next
      If NetWorkInfo <> "" Then Exit For
    End If
  Next
  If objNetwork_2.DHCPEnabled = "True" Then
    DHCPinfo= "动态IP "
  Else
    DHCPinfo="静态IP"
  end if
  
Dim FileName, info
Dim fs, fso
FileName =SerVerPath & "\电脑巡检登记表.csv"
info = name & "," & bumen & "," & yewu & "," & OSInfo & "," & DHCPinfo & NetWorkInfo & "," & BoardInfo & "," & CPUInfo &"," & MemoryInfo &"," & DiskInfo & ","& VideoInfo  
Set fs = CreateObject("Scripting.FileSystemObject")
Set fso = fs.OpenTextFile(FileName, 8, True)  '第三个参数表明文件不存在，则新建文件
fso.WriteLine info
fso.Close
Set fso = Nothing
Set fs = Nothing
msgbox "收集完成！"