We help IT Professionals succeed at work.

VBScript (Hosts File add/remove multiple entries)

Paraleptropy
Paraleptropy asked
on
4,627 Views
Last Modified: 2012-05-11
This script was written by Bill Prew of this stie:
Option Explicit
 
Dim objShell, strSystemRoot, strHostsFile
 
' Get the location of the hosts file
Set objShell = CreateObject("WScript.Shell")
strSystemRoot = objShell.ExpandEnvironmentStrings("%systemroot%")
strHostsFile = strSystemRoot & "\system32\drivers\etc\hosts"
 
' Add an entry to the hosts file
AddHostAlias strHostsFile, "testHost", "127.3.1.1"
 
' Delete an entry in the hosts file specifying IP address
DelHostEntry strHostsFile, "128.5.1.3"
 
' Delete an entry in the hosts file specifying host name
DelHostAlias strHostsFile, "MYNEW.HOST.COM"
 

 
' Support routines below here, do not modify
Function GetHostAliases(strHostFile,strIP)
 
Const fileRead = 1
 
Dim objFSO , objFlagFile
Dim strLine, arrHostEnteries , strHostAliases, i
 
Dim Seps(2)
 
strHostAliases = ""
 
Seps(0) = " "
Seps(1) = vbTab
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists( strHostFile ) Then
    Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
    Do While Not objFlagFile.AtEndOfStream
           strLine = Trim(objFlagFile.ReadLine)
           If strLine <> "" AND Left(strLine,1) <> "#" Then
               If InStr(strLine, "#") > 0 Then
                   strLine = Left(strLine,InStr(strLine, "#") - 1)
               End If
               arrHostEnteries = Tokenize( strLine , Seps )
               If( UBound( arrHostEnteries ) > 0 ) Then
                   If UCase(arrHostEnteries(0)) = UCase(Trim(strIP)) Then
                       For i = (LBound( arrHostEnteries ) + 1) _
                         To (UBound( arrHostEnteries ) - 1)
                           strHostAliases = _
                             strHostAliases & arrHostEnteries(i) & " "
                       Next
                   End If
               End If
             End If
      Loop
      objFlagFile.Close
End If
    GetHostAliases = Tokenize( Trim(strHostAliases) , Seps )
End Function
 
Sub DelHostEntry(strHostFile,strIP)
 
 Const fileRead = 1
 Const fileWrite = 2
 Const fileAppend = 8
 Const SPACES = 20
 
 Dim objFSO , objFlagFile
 Dim strLine, strNewHostFile , strNewHostLine, arrHostEnteries, i
 Dim nNameLen
 Dim nAddSpaces
 
 Dim Seps(2)
 
 Seps(0) = " "
 Seps(1) = vbTab
 
 strNewHostFile = ""
 strNewHostLine = ""
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 If objFSO.FileExists( strHostFile ) Then
    Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
    Do While Not objFlagFile.AtEndOfStream
           strLine = Trim(objFlagFile.ReadLine)
           If strLine <> "" AND Left(strLine,1) <> "#" Then
                 arrHostEnteries = Tokenize( strLine , Seps )
                 If UBound( arrHostEnteries ) > 0 Then
                   If UBound( arrHostEnteries ) = 1 OR UCase(arrHostEnteries(0)) = _
                      UCase(Trim(strIP)) Then ' Check for Aliases and remove it not correct
                       strNewHostLine = ""
                   Else
                       nNameLen = Len(arrHostEnteries(0))
                       nAddSpaces = SPACES - nNameLen
                       strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
                       For i = (LBound( arrHostEnteries ) + 1) _
                                To (UBound( arrHostEnteries ) - 1)
                           strNewHostLine = strNewHostLine & " " & arrHostEnteries(i)
                       Next
                   End If
               End If
 
               If strNewHostLine <> "" Then
                   strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
            End If
 
        Else ' Comments and Blank Lines Added Here
               strNewHostLine = strLine
               strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
        End If
        strNewHostLine = ""
      Loop
      objFlagFile.Close
 End If
 
 Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
 objFlagFile.Write strNewHostFile
 objFlagFile.Close
 
End Sub
 
Sub DelHostAlias(strHostFile,strHost)
 
 Const fileRead = 1
 Const fileWrite = 2
 Const fileAppend = 8
 Const SPACES = 20
 
 Dim objFSO , objFlagFile
 Dim strLine, strNewHostFile , strComment, strNewHostLine, arrHostEnteries, i
 Dim Seps(2)
 
 Dim nNameLen
 Dim nAddSpaces
 
 Seps(0) = " "
 Seps(1) = vbTab
 
 strComment = ""
 strNewHostFile = ""
 strNewHostLine = ""
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 If objFSO.FileExists( strHostFile ) Then
    Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
    Do While Not objFlagFile.AtEndOfStream
           strLine = Trim(objFlagFile.ReadLine)
           If strLine <> "" AND Left(strLine,1) <> "#" Then
               If InStr(strLine, "#") > 0 Then
                   strComment = " " & Right( strLine , _
                       Len( strLine ) - InStr(strLine, "#") + 1 )
                   strLine = Left(strLine,InStr(strLine, "#") - 1)
               Else
                   strComment = ""
            End If
                 arrHostEnteries = Tokenize( strLine , Seps )
                 If UBound( arrHostEnteries ) > 0 Then
                     nNameLen = Len(arrHostEnteries(0))
                   nAddSpaces = SPACES - nNameLen
                     strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
                   If UBound( arrHostEnteries ) = 1 Then
                       strNewHostLine = ""
                       strComment = ""
                   Else
                       For i = (LBound( arrHostEnteries ) + 1) _
                               To (UBound( arrHostEnteries ) - 1)
                           If UCase(arrHostEnteries(i)) <> UCase(Trim(strHost)) Then
                               strNewHostLine = strNewHostLine _
                                         & " " & arrHostEnteries(i)
                           ElseIf UBound( arrHostEnteries ) = 2 Then
                               strNewHostLine = ""
                               strComment = ""
                           End If
                          Next
                      End If
               End If
 
               If strNewHostLine <> "" Then
                   strNewHostFile = strNewHostFile & _
                          strNewHostLine & strComment & vbCRLF
            End If
 
        Else ' Comments and Blank Lines Added Here
               strNewHostLine = strLine
               strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
        End If
        strNewHostLine = ""
      Loop
      objFlagFile.Close
 End If
 
 Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
 objFlagFile.Write strNewHostFile
 objFlagFile.Close
 
End Sub
 
Sub AddHostAlias(strHostFile,strHost,strIP)
 Const fileRead = 1
 Const fileWrite = 2
 Const fileAppend = 8
 Const SPACES = 20
 
 Dim objFSO , objFlagFile
 Dim strLine, strHostEntry, strNewHostFile , strNewHostLine, _
    strComment, bFound, bOmitRemainder, arrHostEnteries, i
 Dim Seps(2)
 
 Dim nNameLen
 Dim nAddSpaces
 
 Seps(0) = " "
 Seps(1) = vbTab
 
 bFound = False
 bOmitRemainder = False
 
 strComment = ""
 strNewHostFile = ""
 strNewHostLine = ""
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 If objFSO.FileExists( strHostFile ) Then
 
  Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
  Do While Not objFlagFile.AtEndOfStream
       strLine = Trim(objFlagFile.ReadLine)
       If strLine <> "" AND Left(strLine,1) <> "#" Then
           If InStr(strLine, "#") > 0 Then
               strComment = " " & Right( strLine , _
                  Len( strLine ) - InStr(strLine, "#") + 1 )
               strLine = Left(strLine,InStr(strLine, "#") - 1)
           Else
               strComment = ""
           End If
           arrHostEnteries = Tokenize( strLine , Seps )
           If UBound( arrHostEnteries ) > 0 Then
               nNameLen = Len(arrHostEnteries(0))
               nAddSpaces = SPACES - nNameLen
                 strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
               If UCase(arrHostEnteries(0)) = UCase(Trim(strIP)) Then
               'Check the entries for certain IP...
                   For i = (LBound( arrHostEnteries ) + 1) _
                            To (UBound( arrHostEnteries ) - 1)
                       If UCase(arrHostEnteries(i)) = UCase(Trim(strHost)) Then
                           bFound    = True
                           strNewHostLine = strNewHostLine _
                                  & " " & Trim(strHost)
                       Else
                           strNewHostLine = strNewHostLine _
                                    & " " & arrHostEnteries(i)
                       End If
                   Next
 
                   If Not bFound Then
                       strNewHostLine = strNewHostLine _
                              & " " & Trim(strHost)
                       bFound = True
                   End If
 
               Else 'Check if it exist in different IP ranges and remove them
                   If UBound( arrHostEnteries ) = 1 Then
                       strNewHostLine = ""
                       strComment = ""
                   Else
                       For i = (LBound( arrHostEnteries ) + 1) _
                                To (UBound( arrHostEnteries ) - 1)
                           If UCase(arrHostEnteries(i)) <> UCase(Trim(strHost)) Then
                               strNewHostLine = strNewHostLine _
                                        & " " & arrHostEnteries(i)
                           ElseIf UBound( arrHostEnteries ) = 2 Then
                               strNewHostLine = ""
                               strComment = ""
                           End If
                          Next
                      End If
               End If
           End If
           If strNewHostLine <> "" Then
               strNewHostFile = strNewHostFile & _
                      strNewHostLine & strComment & vbCRLF
        End If
       Else ' Comments and Blank Lines Added Here
           strNewHostLine = strLine
           strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
    End If
    strNewHostLine = ""
  Loop
  objFlagFile.Close
 
  If Not bFound Then
      strNewHostLine = Trim(strIP) & "       "_
                  & Trim(strHost) & vbCRLF
      strNewHostFile = strNewHostFile & strNewHostLine
  End If
 
 Else ' File doesn't exist so create it and write
      strNewHostFile = Trim(strIP) & _
             "       " & Trim(strHost)
 End If
 
 Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
 objFlagFile.Write strNewHostFile
 objFlagFile.Close
 
End Sub
 
Function Tokenize(byVal TokenString, byRef TokenSeparators())
 
    Dim NumWords, a(), i
    NumWords = 0
 
    Dim NumSeps
    NumSeps = UBound(TokenSeparators)
 
    Do
        Dim SepIndex, SepPosition
        SepPosition = 0
        SepIndex    = -1
 
        for i = 0 to NumSeps-1
 
            ' Find location of separator in the string
            Dim pos
            pos = InStr(TokenString, TokenSeparators(i))
 
            ' Is the separator present, and is it closest
            ' to the beginning of the string?
            If pos > 0 and ( (SepPosition = 0) or _
                     (pos < SepPosition) ) Then
                SepPosition = pos
                SepIndex    = i
            End If
 
        Next
 
        ' Did we find any separators?
        If SepIndex < 0 Then
 
            ' None found - so the token is the remaining string
            redim preserve a(NumWords+1)
            a(NumWords) = TokenString
 
        Else
 
            ' Found a token - pull out the substring
            Dim substr
            substr = Trim(Left(TokenString, SepPosition-1))
 
            ' Add the token to the list
            redim preserve a(NumWords+1)
            a(NumWords) = substr
 
            ' Cutoff the token we just found
            Dim TrimPosition
            TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
            TokenString = Trim(Mid(TokenString, TrimPosition))
 
        End If
 
        NumWords = NumWords + 1
    loop while (SepIndex >= 0)
 
    Tokenize = a
 
End Function
 

Open in new window


What I'd like to do is have it modified to be able to add/remove multiple entries as well as possibly be able to add/remove up to 2 alias's per IP address.  I thank you for your assistance in advance.

Regards
Comment
Watch Question

Neil RussellTechnical Development Lead
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
I'll give this a try in the morning.  Thanks for the quick reply.  Would you know how to add/remove a value such as this:

AddHostAlias strHostsFile, "testHostAlias1", "127.3.1.1", "LocalHost"

I tried playing around with this with another script but I couldn't get it to work properly.
Neil RussellTechnical Development Lead

Commented:
The script as it stands would need considerable rewrite to handle that. I'm in the pub right now but tomorrow maybe :P
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
As I recall, that was the hardest 50 points I ever earned :-).

Anyway, what do you want the hosts file line to look like for:

AddHostAlias strHostsFile, "testHostAlias1", "127.3.1.1", "LocalHost"

~bp

Author

Commented:
Bill,

I did read what you said and figured the solution and/or modification was worth at the minimum 250 (figuring you could get a few more for your effort).

I pay for the service here.  Because of the work you put into your script, I'd like to give you your fair share.  I can always give the full 500 and split it up, giving you most of the credit you deserve.  This does look like a 'multiple solution" item.

Anyhow, the host file line should be:

TestHostAlias1     123.45.67.89     localwhatever

basically, some of these lines will have 3 entries.  I just want to make sure that when I apply the script, it will take this into consideration.

Thanks alot everyone, you are all too kind and very helpful.
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
Thank You!
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.