VBS 获取指定电脑的部分信息...
2010-03-18 09:06
375 查看
Program Name: Get_Remote_PC_Partial_Information.vbs
----The Code as Below
'--------------------------
'Author By: Wei_Zhu
'Creation Date: 2010-03-08
'--------------------------
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook=objExcel.Workbooks.Add() 'This is add new
Set objRange = objExcel.Range("A1","E1")
objRange.Font.Size = 10
objrange.Font.Bold = True
objrange.Font.Name = "Times New Roman"
objrange.Cells(1).Value="Domain"
objrange.Cells(2).Value="IP"
objrange.Cells(3).Value="Manufacturer"
objrange.Cells(4).Value="Model"
objrange.Cells(5).Value="Serial Number"
objrange.Interior.ColorIndex = 34 'Set BackColor
objRange.Borders.LineStyle = 1
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
'----Auto Fill The Column Width---
Set objcol = objExcel.Columns("A:E").EntireColumn
objcol.AutoFit
set ws=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
set folder=fso.getfolder(ws.CurrentDirectory&"/Computer")
Set fc = folder.Files
For Each f1 in fc
s = folder&"/" & f1.name
set ts = fso.OpenTextFile(s, ForReading)
lint_line =2
Do While Not ts.AtEndOfStream
l_ip = ts.ReadLine
GetPCInfo l_ip,f1.Name,lint_line
lint_line = lint_line +1
Loop
lint_line=0
ts.Close
Next
objExcel.DisplayAlerts = False 'Close the Alert
'objExcel.ActiveWorkBook.Saveas lstg_to_f,-4143
'msgbox lstg_to_f
objExcel.ActiveWorkBook.Saveas folder&".xls",-4143
objExcel.DisplayAlerts = False ''Close the Save Alert
objExcel.ActiveWorkbook.Close
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Function GetPCInfo(ByVal ip, ByVal l_fn, ByVal l_line)
'Function GetPCInfo(l_fn,l_line)
strComputer = ip
objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2")
colItems = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
l_Array = Split(l_fn, ".", -1, 1)
For Each objItem In colItems
'MsgBox "Manufacturer: " & objItem.Manufacturer
' Msgbox "Product: " & objItem.Product
' Msgbox "Serial Number: " & objItem.SerialNumber
objRange = objExcel.Range("A" & l_line, "E" & l_line)
objRange.Cells(1).value = l_Array(0)
objRange.Cells(2).value = ip
objRange.Cells(3).value = objItem.Manufacturer
objRange.Cells(4).value = objItem.Model
objRange.Cells(5).value = objItem.SerialNumber
Next
'----Auto Fill The Column Width---
objcol = objExcel.Columns("A:E").EntireColumn
objcol.AutoFit()
'----Note----
The Win Server 2003 or high must class Win32_SystemEnclosure get Manufacturer information,...etc.
----The Code as Below
'--------------------------
'Author By: Wei_Zhu
'Creation Date: 2010-03-08
'--------------------------
On Error Resume Next
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook=objExcel.Workbooks.Add() 'This is add new
Set objRange = objExcel.Range("A1","E1")
objRange.Font.Size = 10
objrange.Font.Bold = True
objrange.Font.Name = "Times New Roman"
objrange.Cells(1).Value="Domain"
objrange.Cells(2).Value="IP"
objrange.Cells(3).Value="Manufacturer"
objrange.Cells(4).Value="Model"
objrange.Cells(5).Value="Serial Number"
objrange.Interior.ColorIndex = 34 'Set BackColor
objRange.Borders.LineStyle = 1
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
'----Auto Fill The Column Width---
Set objcol = objExcel.Columns("A:E").EntireColumn
objcol.AutoFit
set ws=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
set folder=fso.getfolder(ws.CurrentDirectory&"/Computer")
Set fc = folder.Files
For Each f1 in fc
s = folder&"/" & f1.name
set ts = fso.OpenTextFile(s, ForReading)
lint_line =2
Do While Not ts.AtEndOfStream
l_ip = ts.ReadLine
GetPCInfo l_ip,f1.Name,lint_line
lint_line = lint_line +1
Loop
lint_line=0
ts.Close
Next
objExcel.DisplayAlerts = False 'Close the Alert
'objExcel.ActiveWorkBook.Saveas lstg_to_f,-4143
'msgbox lstg_to_f
objExcel.ActiveWorkBook.Saveas folder&".xls",-4143
objExcel.DisplayAlerts = False ''Close the Save Alert
objExcel.ActiveWorkbook.Close
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Function GetPCInfo(ByVal ip, ByVal l_fn, ByVal l_line)
'Function GetPCInfo(l_fn,l_line)
strComputer = ip
objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2")
colItems = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
l_Array = Split(l_fn, ".", -1, 1)
For Each objItem In colItems
'MsgBox "Manufacturer: " & objItem.Manufacturer
' Msgbox "Product: " & objItem.Product
' Msgbox "Serial Number: " & objItem.SerialNumber
objRange = objExcel.Range("A" & l_line, "E" & l_line)
objRange.Cells(1).value = l_Array(0)
objRange.Cells(2).value = ip
objRange.Cells(3).value = objItem.Manufacturer
objRange.Cells(4).value = objItem.Model
objRange.Cells(5).value = objItem.SerialNumber
Next
'----Auto Fill The Column Width---
objcol = objExcel.Columns("A:E").EntireColumn
objcol.AutoFit()
'----Note----
The Win Server 2003 or high must class Win32_SystemEnclosure get Manufacturer information,...etc.
相关文章推荐
- VBS 获取指定电脑的部分信息...
- 关于提取电脑软硬件信息并保存指定位置的VBS
- Azure Powershell获取指定订阅下的虚拟机信息(ASM)
- 获取地图上指定的一个表中所选择到的图元的信息
- python3获取指定目录内容的详细信息
- 获取指定表述信息的串口号
- 玩转Web之easyui(三)-----easy ui dataGird 重新指定url以获取不同数据源信息
- 获取本机信息如IP 电脑名称等类
- Installshield x:实现序列号检验,获取用户信息并写入指定_ini文件1 - 子夜 MySpace聚友博客
- JavaScript 相关 —— 向页面写JS以alert信息、通过对地址栏赋值转到指定页、注册Js到Body的开始部分、注册Js到Body的结束位置
- 利用python获取指定url在ATS中缓存对象的信息
- 通过VBS 获取系统所有服务信息
- 通过VBS访问WMI,获取当前所有进程信息
- Java获取电脑CPU个数及系统信息
- 获取指定(访客)IP的所有信息,地址、邮政编码、国家、经纬度等的API
- 微信公众号获取用户信息已经菜单栏跳转指定页面
- 获取指定类上的@RequestMapping注解的请求信息
- 获取Android应用程序出错信息并将信息发送到指定邮件 .
- 09-获取指定Wi-Fi信息
- js 获取哦 URL 各个部分的信息