コンピュータ名の変更

MACアドレスとコンピュータ名の対照表を参照して、コンピュータ名を変更する。 対照表はカンマ区切りとし、物理アドレス,コンピューター名のフォーマットで記述する。 パス1はネットワークドライブ上に設定し、パス2はローカルファイルシステム上に作成する（ネットワーク接続ができなかった時に備える）。

Option Explicit
'------------------------------------------------------------------------------
'    MACAddressを取得
'------------------------------------------------------------------------------
Function GetMacAddr()
    Dim objQfeSet
    Dim objQfe
    Dim objLocator
    Dim objService
    Dim strMAC
    
    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objService = objLocator.ConnectServer
    Set objQfeSet = objService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration")
    
    For Each objQfe In objQfeSet
        If objQfe.IPEnabled = True Then
            strMAC = objQfe.MACAddress
        End If
    Next

    Set objQfeSet = Nothing
    Set objQfe = Nothing
    Set objService = Nothing
    Set objLocator = Nothing

    GetMacAddr = strMAC
End Function

'------------------------------------------------------------------------------
'    名前変更
'------------------------------------------------------------------------------
Sub ResetName(strNewName)
    Dim objWMIService
    Dim colComputers
    Dim objComputer

    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colComputers = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    For Each objComputer in colComputers
        objComputer.Rename(strNewName)
    Next
End Sub

'------------------------------------------------------------------------------
'    シャットダウン・リブート
'------------------------------------------------------------------------------
Sub Reboot(intFlag)
    Set OpSysSet = GetObject("winmgmts:{(Shutdown)}//./root/cimv2").ExecQuery("select * from Win32_OperatingSystem where Primary=true")

    for each OpSys in OpSysSet
        if intFlag = 1 Then
            OpSys.Reboot()
        Else
            OpSys.Shutdown()
        End If
    next
End Sub

'------------------------------------------------------------------------------
'    起動時実行に設定
'------------------------------------------------------------------------------
Sub SetRunOnce(strPath)
    Dim WshShell, bKey
    Set WshShell = WScript.CreateObject("WScript.Shell")

    WshShell.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce\exec", strPath, "REG_SZ"
End Sub

'------------------------------------------------------------------------------
'    ドメイン参加
'------------------------------------------------------------------------------
Function JoinDomain(strDomain, strUser, strPassword)
    Const JOIN_DOMAIN             = 1
    Const ACCT_CREATE             = 2
    Const ACCT_DELETE             = 4
    Const WIN9X_UPGRADE           = 16
    Const DOMAIN_JOIN_IF_JOINED   = 32
    Const JOIN_UNSECURE           = 64
    Const MACHINE_PASSWORD_PASSED = 128
    Const DEFERRED_SPN_SET        = 256
    Const INSTALL_INVOCATION      = 262144

    Set objNetwork = CreateObject("WScript.Network")
    strComputer = objNetwork.ComputerName
    Set objComputer = _
        GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & _
        strComputer & "\root\cimv2:Win32_ComputerSystem.Name='" _
        & strComputer & "'")
    JoinDomain = objComputer.JoinDomainOrWorkGroup(strDomain, _
        strPassword, _
        strDomain & "\" & strUser, _
        NULL, _
        JOIN_DOMAIN + ACCT_CREATE)
End Function

'------------------------------------------------------------------------------
'    MACアドレスと名前の対照表から新しい名前を返す
'------------------------------------------------------------------------------
Function GetNewName(strMac, strPath1, strPath2)
    Dim objFS
    Dim objFile
    Dim aryStrings
    
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    If objFS.FileExists(strPath2) And objFS.FileExists(strPath1) Then
        MsgBox "設定ファイルが存在しません。手動で設定してください。"
        WScript.Quit
    End If

    strMac = Replace(strMac, "-", ":")

    If Not objFS.FileExists(strPath1) Then
        strPath1 = strPath2
    End If
    Set objFile = objFS.OpenTextFile(strPath1)
    Do Until objFile.AtEndOfStream
        aryStrings = Split(Trim(objFile.ReadLine), ",")
        aryStrings(0) = Replace(aryStrings(0), "-", ":")
        If (UBound(aryStrings) - LBound(aryStrings)) + 1 = 2 Then
            If Len(Trim(aryStrings(0))) = Len(Trim(strMac)) Then
                If UCase(Trim(aryStrings(0))) = UCase(Trim(strMac)) Then
                    GetNewName = UCase(Trim(aryStrings(1)))
                    Exit Function
                End If
            End If
        End If
    Loop
    GetNewName = "00000000"
End Function

'------------------------------------------------------------------------------
'
'    メインルーチン
'
'------------------------------------------------------------------------------
Dim strNew
Dim objArg
Dim i
Dim strPath1, strPath2

Set objArg = WScript.Arguments
MsgBox objArg.Count
If objArg.Count = 1 Then
    strPath1 = objArg(0)
End If

strNew = GetNewName(GetMacAddr(), strPath1, "ローカルファイルへのパス")
If "00000000" <> strNew Then
    ResetName(strNew)
Else
    MsgBox "設定情報が存在しません。手動で設定してください。"
End If

コンピュータ名の変更で、最も簡単なのは、

C:\> wmic ComputerSystem WHERE "name='%computername%'" Call Rename "新しいコンピュータ名"

 

 

Keywords
Windows Utility