Paraleptropy
asked on
VBScript (Hosts File add/remove multiple entries)
This script was written by Bill Prew of this stie:
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
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
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
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
The script as it stands would need considerable rewrite to handle that. I'm in the pub right now but tomorrow maybe :P
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
Anyway, what do you want the hosts file line to look like for:
AddHostAlias strHostsFile, "testHostAlias1", "127.3.1.1", "LocalHost"
~bp
ASKER
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.
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank You!
ASKER
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.