HOSTS 文件修改

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Const MAX_LEN = 255 '字符串最大长度
Dim sTmp As String * MAX_LEN  '存放结果的固定长度的字符串
Dim nLength As Long '字符串的实际长度
Dim System32dir As String '保存System32目录
Dim hostsStr As String '保存修改后的HOSTS文件
Dim a As Boolean '标志位，判断是否是错误的记录

Sub Main()
   
    nLength = GetSystemDirectory(sTmp, MAX_LEN) '获取System32目录
    System32dir = Left(sTmp, nLength)
    Open System32dir & "\drivers\etc\hosts" For Input As #1    '打开hosts文件
        Do While Not EOF(1)
            Line Input #1, TempStr

            If Asc(TempStr & "#") <> 35 Then ' Asc("#") = 35    '是否为#号开头的注释或者空行
               
                If Trim(Mid(Trim(TempStr), InStr(1, Trim(TempStr), " ") + 1, Len(Trim(TempStr)) - InStr(1, Trim(TempStr), " "))) = "www.vbgood.com" Then  '检查是否有域名
                   
                    If Mid(Trim(TempStr), 1, InStr(1, Trim(TempStr), " ") - 1) = "203.215.243.67" Then  '判断IP地址是否正确
                        GoTo 100 '如果有了就不重复添加了，直接退出
                    Else
                        TempStr = Replace(TempStr, Mid(Trim(TempStr), 1, InStr(1, Trim(TempStr), " ") - 1), "203.215.243.67")
                        a = True
                    End If
                End If
            End If
            hostsStr = hostsStr & TempStr & vbCrLf
        Loop
        hostsStr = Mid(hostsStr, 1, Len(hostsStr) - 1) '去掉最后一个回车符
    
    Close #1    '关闭文件
    'http://www.imcode.cn
    If a Then
        
        Open System32dir & "\drivers\etc\hosts" For Output As #1 '修改
            Print #1, hostsStr
        Close #1
    Else
        
        Open System32dir & "\drivers\etc\hosts" For Append As #2 'Append方式写hosts文件
            Print #2, "203.215.243.67  www.vbgood.com"
        Close #2
    End If
    '打开www.vbgood.com
    Call ShellExecute(hwnd, "open", "http://www.vbgood.com/vb.good/", "", App.Path, 1)
    Call DeleteByMySelf '自删除,调试时谨慎使用！

End Sub

Private Sub Form_Load()

End Sub

转载请注明出处：吖Go博客 » HOSTS 文件修改