Home

Comments

The Windows Hosts file is very useful if you want to override you DNS Server's Domain records. I find I change mine quite often and have written the Hosts Collection to automate editing it. Although the Hosts Collection is designed to be compatible with both Win 95/98/Me and Win 2K/XP I've only tested it with Win 2K.

If you don't know what the Hosts file is then you're not ready to use this code. Check the links at the bottom of this page to learn more about the Hosts file.

Note: The Hosts collection only accepts records in the form "[Host Name] [IP Address] #[Comment]". Any record that does not conform will be removed from your initial Hosts file. The initial Hosts file (if it exists) is backed up to %HostsPath%\HostsBackup so you can always restore it later.

Reference

HostsCollection Properties

NewEnum

Read-Only

Return Type is a IUnknown

Count

Read-Only

Return Type is a Long

Comment

Read-Only

Return Type is a String

Name	Type	Description

HostName	String

IPAddress [= IPAddress]

Read-Write

Return Type is a String

Name	Type	Description

HostName	String
IPAddress	String

Path

Read-Only

Return Type is a String

HostsCollection Methods

Exists (HostName)

Return Type is a Boolean Value

Name	Type	Description

HostName	String

Remove (HostName)

Return Type is a Boolean Value

Name	Type	Description

HostName	String

Add (HostName, IPAddress[, Comment])

Return Type is a Boolean Value

Name	Type	Description

HostName	String
IPAddress	String
Comment	String	Optional

HostClass Properties

Comment [= Value]

Read-Write

Return Type is a String

Name	Type	Description

Value	String

HostName [= Value]

Read-Write

Return Type is a String

Name	Type	Description

Value	String

IPAddress [= Value]

Read-Write

Return Type is a String

Name	Type	Description

Value	String

Usage

Add HostsCollection.cls and HostClass.cls to your project set the Procedure ID for HostCollection's NewEnum Property to -4 (from the Tools/Procedure Attributes menu in the IDE)

   Option Explicit

   Dim Hosts As HostsCollection
   Dim h As HostClass

   Set Hosts = New HostsCollection

   'Add a Hosts entry
   Hosts.Add "www.paradoxes.info", "67.17.17.120"

   'Edit the entry
   Hosts.IPAddress("www.paradoxes.info") = "127.0.0.1"

   'Enumerate the Hosts collection
   For Each h In Hosts
      Debug.Print "Domain: " & h.HostName & " IP: " & h.IPAddress
   Next

   'Remove the entry
   Hosts.Remove "www.paradoxes.info"

   Set Hosts = Nothing

The Code

HostsCollection.cls

Option Explicit

Private Enum ePlatform
   VER_PLATFORM_WIN32_WINDOWS = 1
   VER_PLATFORM_WIN32_NT = 2
End Enum

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal uSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal uSize As Long) As Long

Private mHostsPath As String

Private mHosts As Collection

Public Property Get Path() As String

   Path = mHostsPath

End Property

Public Property Get IPAddress(HostName As String) As String

   If Exists(HostName) Then
      IPAddress = mHosts(HostName).IPAddress
   End If

End Property

Public Property Let IPAddress(HostName As String, IPAddress As String)

   If Exists(HostName) Then
      If IPAddress <> mHosts(HostName).IPAddress Then
         mHosts(HostName).IPAddress = IPAddress
         Update
      End If
   Else
      If Add(HostName, IPAddress) Then
         Update
      End If
   End If

End Property

Public Property Get Comment(HostName As String) As String

   If Exists(HostName) Then
      Comment = mHosts(HostName).Comment
   End If

End Property

Public Property Get Count() As Long

   Count = mHosts.Count

End Property

Public Property Get NewEnum() As IUnknown

   Set NewEnum = mHosts.[_NewEnum]

End Property

Public Function Add(HostName As String, IPAddress As String, Optional Comment _
As String) As Boolean

   Dim h As HostClass

   If Not Exists(HostName) Then
      If IsIPAddress(IPAddress) Then
         Set h = New HostClass
         h.HostName = HostName
         h.IPAddress = IPAddress
         h.Comment = Comment
         mHosts.Add h, h.HostName
         Update
         Add = True
      End If
   End If

End Function

Public Function Remove(HostName As String) As Boolean

   If Exists(HostName) Then
      mHosts.Remove HostName
      Update
      Remove = True
   End If

End Function

Public Function Exists(HostName As String) As Boolean

   Dim v As Variant

   On Error GoTo eh

   Set v = mHosts(HostName)
   Set v = Nothing
   Exists = True

eh:
End Function

Private Function Update() As Boolean

   Dim s As String
   Dim fh As Long
   Dim h As HostClass

   For Each h In mHosts
      s = s & h.IPAddress & " " & h.HostName
      If Len(h.Comment) > 0 Then
         s = s & " #" & h.Comment
      End If
      s = s & vbCrLf
   Next
   If Len(s) > 0 Then
      s = Left$(s, Len(s) - 2)
   End If

   fh = FreeFile
   If RemoveFile(mHostsPath) Then
      Open mHostsPath For Binary As #fh
      Put #fh, , s
      Close #fh
      Update = True
   End If

End Function

Private Function GetPlatform() As ePlatform

   Dim os As OSVERSIONINFO
   Dim r As Long

   os.dwOSVersionInfoSize = Len(os)
   r = GetVersionEx(os)
   GetPlatform = os.dwPlatformId

End Function

Private Function GetSystemFolder() As String

   Dim s As String
   Dim r As Long

   r = GetSystemDirectory(s, Len(s))
   If r > Len(s) Then
      s = Space(r)
      r = GetSystemDirectory(s, Len(s))
   End If
   s = Left$(s, r)

   If Right(s, 1) = "\" Then
      GetSystemFolder = Left(s, Len(s) - 1)
   Else
      GetSystemFolder = s
   End If

End Function

Private Function GetWindowsFolder() As String

   Dim s As String
   Dim r As Long

   r = GetWindowsDirectory(s, Len(s))
   If r > Len(s) Then
      s = Space(r)
      r = GetWindowsDirectory(s, Len(s))
   End If
   s = Left$(s, r)

   If Right(s, 1) = "\" Then
      GetWindowsFolder = Left(s, Len(s) - 1)
   Else
      GetWindowsFolder = s
   End If

End Function

Private Sub LoadHosts()

   Dim a() As String
   Dim s As String
   Dim fh As Long
   Dim l As Long
   Dim h As HostClass

   Set mHosts = New Collection

   If GetPlatform = VER_PLATFORM_WIN32_NT Then
      mHostsPath = GetSystemFolder & "\drivers\etc\hosts"
   Else
      mHostsPath = GetWindowsFolder & "\hosts"
   End If

   fh = FreeFile
   Open mHostsPath For Binary As #fh
   s = Space(LOF(fh))
   Get #fh, , s
   Close #fh

   If Not FileExists(mHostsPath & "Backup") Then
      fh = FreeFile
      Open mHostsPath & "Backup" For Binary As #fh
      Put #fh, , s
      Close #fh
   End If

   a = Split(s, vbCrLf)
   For l = 0 To UBound(a)
      Set h = ParseHost(a(l))
      If Not h Is Nothing Then
         If Not Exists(h.HostName) Then
            mHosts.Add h, h.HostName
         End If
         Set h = Nothing
      End If
   Next

End Sub

Private Function ParseHost(Text As String) As HostClass

   Dim l As Long
   Dim s As String
   Dim Comment As String
   Dim IPAddress As String
   Dim HostName As String
   Dim h As HostClass

   s = Text
   l = InStr(1, s, "#")
   If l > 0 Then
      Comment = Right$(s, Len(s) - l)
      Text = Left$(s, l - 1)
   End If

   s = Replace$(s, vbTab, " ")
   Do
      l = Len(s)
      s = Replace$(s, "  ", " ")
   Loop Until l = Len(s)

   l = InStr(1, s, " ")
   If l > 0 Then
      IPAddress = Trim$(Left$(s, l - 1))
      HostName = Trim$(Right$(s, Len(s) - l))
   End If

   If IsIPAddress(IPAddress) Then
      Set h = New HostClass
      h.IPAddress = IPAddress
      h.HostName = HostName
      h.Comment = Comment
      Set ParseHost = h
      Set h = Nothing
   End If

End Function

Private Function IsIPAddress(IPAddress As String) As Boolean

   Dim s As String

   s = Replace$(IPAddress, ".", "")
   If Len(s) + 3 = Len(IPAddress) Then
      If IsNumeric(s) Then
         IsIPAddress = True
      End If
   End If

End Function

Private Function RemoveFile(Path As String) As Boolean

   On Error GoTo eh

   Kill Path
   RemoveFile = True

eh:
End Function

Private Function FileExists(Path As String) As Boolean

   If Len(Dir$(Path)) > 0 Then
      FileExists = True
   End If

End Function

Private Sub Class_Initialize()

   LoadHosts

End Sub

Private Sub Class_Terminate()

   Set mHosts = Nothing

End Sub

HostClass.cls

Option Explicit

Public IPAddress As String
Public HostName As String
Public Comment As String

Downloads

Hosts.zip - contains: HostsCollection.cls, HostClass.cls (2.2 kb)

Links

A good detail of the Hosts file and its use by Gorilla Design Studio

Unless otherwise stated, the code on this site is Copyright to Andrew McMillan. You may use this code in your projects (both commercial and non-commercial) but you are not permitted to republish this code in any form without the Author's prior consent.

The code on this site is supplied "as is" and no claims are made as to its soundness. The Author claims no responsibility for or liability from use of said source code.

Home

Comments

Reference

Usage

The Code

Downloads

Links

© Copyright Notice