批处理之家 - Powered by Discuz! Board

' 重命名当前计算机，并获取当前系统硬件信息，保存到 %ComputerName%.txt
On Error Resume Next
RunasAdmin
pcName = InputBox("请输入新计算机名：","重命名PC")
' WScript.Echo pcName
' WScript.Quit
renameResult = RenamePC(pcName)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = 0
Set WSHNetwork = WScript.CreateObject("WScript.Network")
If renameResult Then
ComputerName = pcName
Else
ComputerName = WSHNetwork.ComputerName
End If
TempFiles = fso.GetParentFolderName(WScript.ScriptFullName) & "\" & ComputerName & ".txt"
Set TempFile = fso.CreateTextFile(TempFiles)
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set CPU = objWMIService.ExecQuery("Select * From Win32_Processor")
For Each Item In CPU
CPU2 = "CPU:" & Item.Name
Next
Set Board = objWMIService.ExecQuery("Select * From Win32_BaseBoard")
For Each Item In Board
Board2 = "主板: " & Item.Product
Next
Set colItems = objWMIService.ExecQuery("Select * From Win32_PhysicalMemory",,48)
For Each objItem In colItems
A = objItem.Capacity/1048576
Temp = temp+objItem.Capacity
N = N+1
Next
Memory = Temp/1048576
If N = 1 Then
Memory2 = "内存: " & N & "条" & A & "M"
Else
Memory2 = "内存: " & N & "条" & A & "M" &" 总计" & Memory & "M"
End If
Set Video = objWMIService.ExecQuery("Select * From Win32_VideoController",,48)
For Each Item In Video
Video2 = "显卡: " & Item.Description
Video3 = "分辨率: " & Item.VideoModeDescription
Next
Set VideoA = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor",,48)
For Each Item In VideoA
VideoA = "显示器名称: " & Item.Description
VideoB = "屏幕高度: " & Item.ScreenHeight & " 屏幕宽度: " & Item.ScreenWidth
Next
Set Disk = objWMIService.ExecQuery("Select * From Win32_DiskDrive")
For Each Item In Disk
Disk2 = Disk2 & Item.Model
Disk4 = Int(Item.Size/1000/1000/1000) & "G"
Next
Disk3 = "硬盘: " & Trim(Disk2)
Disk5 = "硬盘容量: " & Disk4
Set Network = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each Item In Network
Lan = "网卡: " & Item.Description
IP = "IP地址: " & Item.IPAddress(0)
MacAdd = "MAC地址：" & Item.MACAddress
Next
TempFile.WriteLine(CPU2)
TempFile.WriteLine(Board2)
TempFile.WriteLine(Memory2)
TempFile.WriteLine(Video2)
TempFile.WriteLine(Video3)
TempFile.WriteLine(VideoA)
TempFile.WriteLine(VideoB)
TempFile.WriteLine(Disk3)
TempFile.WriteLine(Disk5)
TempFile.WriteLine(Lan)
TempFile.WriteLine(Ip)
TempFile.WriteLine(MacAdd)
TempFile.Close
fso.CopyFile TempFiles,"\\192.168.8.30\XINXIBU\",true
Set fso = Nothing
Set objWMIService = Nothing
Set WSHNetwork = Nothing
Sub RunasAdmin()
On Error Resume Next
If Not IsVista(".") Then Exit Sub
Dim wshell
Set wshell = CreateObject("WScript.Shell")
wshell.RegRead "HKEY_USERS\S-1-5-19\Environment\TEMP"
If Err.Number <> 0 Then
Dim str,arg,shell
str = ""
Set shell = CreateObject("Shell.Application")
For Each arg In WScript.Arguments
str = str & " """ & arg & """"
Next
shell.ShellExecute WScript.FullName,"//nologo """ & WScript.ScriptFullName & """ " & str, "", "runas", 1
Set shell = Nothing
Set wshell = Nothing
WScript.Quit
Else
Set wshell = Nothing
End If
End Sub
Function IsVista(strComputer)
On Error Resume Next
IsVista = False
Dim objWMIService, colOperationSystems, objOperationSystem
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperationSystems = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem")
For Each objOperationSystem In colOperationSystems
If CInt(Left(objOperationSystem.Version, InStr(1,objOperationSystem.Version,".") - 1)) > 5 Then
IsVista = True
Exit For
End If
Next
Set colOperationSystems = Nothing
Set objWMIService = Nothing
End Function
Function RenamePC(pcnameNew)
' 重命名当前计算机
RenamePC = False
On Error Resume Next
With New RegExp
.Global = True
.Ignorecase = True
.Multiline = False
.Pattern = "[{|}~\[\]\\^':;<=>?@!""#$%`()+/.,*&\s\uD800-\uDFFF]"
If .Test(pcnameNew) Then
WScript.Echo "计算机名含有非法字符"
Exit Function
End If
End With
If Len(pcnameNew) > 15 Or Len(pcnameNew) = 0 Then
WScript.Echo "计算机名长度非法"
Exit Function
End If
Dim wshell,strCmd,oExec
Set wshell = CreateObject("WScript.Shell")
strCmd = "cmd.exe /c reg add ""HKEY_CURRENT_USER\Software\Microsoft\Windows\ShellNoRoam"" /ve /t REG_SZ /d """ & pcnameNew & """ /f&" &_
"reg add ""HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName"" /v ""ComputerName"" /t REG_SZ /d """ & pcnameNew & """ /f&" &_
"reg add ""HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName"" /v ""ComputerName"" /t REG_SZ /d """ & pcnameNew & """ /f&" &_
"reg add ""HKLM\SYSTEM\CurrentControlSet\Services\Eventlog"" /v ""ComputerName"" /t REG_SZ /d """ & pcnameNew & """ /f&" &_
"reg add ""HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"" /v ""NV Hostname"" /t REG_SZ /d """ & pcnameNew & """ /f&" &_
"reg add ""HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"" /v ""Hostname"" /t REG_SZ /d """ & pcnameNew & """ /f"
Set oExec = wshell.Exec(strCmd)
' If Not oExec.StdOut.AtEndOfStream Then
' WScript.Echo oExec.StdOut.ReadAll
' End If
Do While oExec.Status = 0
WScript.Sleep 100
Loop
If oExec.ExitCode <> 0 Then
WScript.Echo "计算机重命名失败: " & oExec.ExitCode
Else
RenamePC = True
End If
Set oExec = Nothing
Set wshell = Nothing
End Function