Question

我想从原始源更新Unbound_DNS配置文件，但我无法获得所需的结果。

我想格式化每个条目（每一行）：

address=/abc.com/0.0.0.0

要

local-zone: "abc.com" redirect
local-data: "abc.com 86400 IN A 0.0.0.0"

这是我做的（感谢hackoofr）：

Option Explicit
Dim URL,Save2File,ws
If Not WScript.Arguments.Named.Exists("elevate") Then
    CreateObject("Shell.Application").ShellExecute WScript.FullName _
    , """" & WScript.ScriptFullName & """ /elevate", "", "runas", 1
    WScript.Quit
End If
URL = "https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt"
Set ws = CreateObject("wscript.Shell")
Save2File = ws.ExpandEnvironmentStrings("%Windir%\Temp\test")
Call Download(URL,Save2File)
'**********************************************************************************************
Sub Download(URL,Save2File)
    Dim File,Line,BS,ws,RegExp
    On Error Resume Next
    Set File = CreateObject("MSXML2.XMLHTTP")
    File.Open "GET",URL, False
    File.Send
    If err.number <> 0 then
        Line  = Line &  vbcrlf & "Error Getting File"
        Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " &  vbcrlf &_
        err.description
        Line  = Line &  vbcrlf & "Source " & err.source 
        MsgBox Line,vbCritical,"Error getting file"
        Err.clear
        wscript.quit
    End If
    If File.Status = 200 Then   
        '**********************************************************************************************
        ' Replace content for use with the file service.conf of soft Unbound_DNS
        '
        ' address=/abc.com/0.0.0.0      to      local-zone: "abc.com" redirect
        '                                       local-data: "abc.com 3600 IN A 0.0.0.0"
        '**********************************************************************************************
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.IgnoreCase = True
        RegExp.Global = True
        RegExp.Pattern = "address=/(.*)/([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})"       
        File.ResponseBody = RegExp.Replace(File.ResponseBody, "local-zone: \""$1\"" redirect $1" & ret & ">local-data: \""$1 3600 IN A $2\""")  
        Set RegExp = Nothing

        '**********************************************************************************************
        ' Write content 
        '**********************************************************************************************
        Set BS = CreateObject("ADODB.Stream")
        Set ws = CreateObject("wscript.Shell")
        BS.type = 1
        BS.open
        BS.Write File.ResponseBody
        BS.SaveToFile Save2File, 2

        '**********************************************************************************************
        ' Clean cache DNS
        '**********************************************************************************************
        wshShell.run("cmd /c psexec \\ -s ipconfig /flushdns >> & hostName,TRUE")
    ElseIf File.Status = 404 Then
        MsgBox "UpdateHostname.vbs : File Not Found : " & File.Status,vbCritical,"UpdateHostname.vbs : Error File Not Found"
    Else
        MsgBox "UpdateHostname.vbs : Unknown Error : " & File.Status,vbCritical,"UpdateHostname.vbs : Error getting file"
    End If
End Sub
'**********************************************************************************************

提前感谢您的帮助。

编辑1： 内容不会改变。 File.ResponseBody正确返回内容，但正则表达式没有修改！

Answer 1

替换以下代码：

Dim objReg, strTest, objMatches, objMatch
Set objReg = New RegExp
strTest = File.ResponseBody                    'address=/abc.com/0.0.0.0
objReg.Global = True
objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})"    'abc.com gets stored in Group 1 and the IP address gets stored in Group 2
Set objMatches = objReg.Execute(strTest)
For Each objMatch In objMatches
    strTest = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_
              "local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&""""
Next
File.ResponseBody = strTest
set objReg = Nothing

用这个：

Click for Regex Demo（在演示中，\被address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})转义

正则表达式说明：

address=/

address=/ - 按字面意思匹配(.*?)
/ - 尽可能少地匹配任何字符的出现次数（换行符除外）。括号用于将此匹配捕获为组1
/ - 按字面意思匹配(\d{1,3}(?:\.\d{1,3}){3})
12.222.212.33 - 匹配模式test的字符串并在第2组中捕获

<强>更新

这是我的最终解决方案。从我的代码中可以理解，您首先从服务器获取响应主体，修改并将更新的响应存储在temp文件夹中名为C:\Windows\Temp\test.txt的文件中。下面是我为完成同样的事情所编写的代码。我已经在我的系统上测试了它，并且存储在Option Explicit Dim File, objReg, strTest, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i Set objShell = CreateObject("wscript.shell") saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt") Set File = CreateObject("MSXML2.XMLHTTP") File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False File.send If File.Status = 200 Then Set objReg = New RegExp strTest = File.responseText 'address=/abc.com/0.0.0.0 objReg.Global = True objReg.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 'abc.com gets stored in Group 1 and the IP address gets stored in Group 2 Set objMatches = objReg.Execute(strTest) For Each objMatch In objMatches strReplace = "local zone: """ & objMatch.Submatches.Item(0) & """ redirect" & vbCrLf &_ "local data: """ & objMatch.Submatches.Item(0) & " 86400 in A " & objMatch.Submatches.Item(1)&"""" & vbCrLf strTest = Replace(strTest,objMatch.Value,strReplace) 'Uncomment the following code to see the result for the 1st 5 URLs, if the whole thing is taking too long to get executed 'i=i+1 'If(i>5) Then ' Exit for 'End If Next set objReg = Nothing '********************************************************************************************** ' Write content '********************************************************************************************** Set fso = CreateObject("scripting.filesystemobject") Set outFile = fso.OpenTextFile(saveToFile,2,True) outFile.Write strTest outFile.Close End If文件中的最终输出看起来正确，如附带的屏幕截图所示。现在，这可能不是你想要的，但你可以从中得到一个想法。将此代码存储在新的vbs文件中，并按原样直接运行。

注意：由于来自服务器的响应文本很长，因此执行需要一些时间。如果您只是想查看它是否正常工作，请取消注释for循环中的代码。您将能够看到您获得了前几个网址所需的结果

Regex Demo

jQuery(document).click(function(e) {
    var target = e.target; //target div recorded
    if (!jQuery(target).is('#tobehide') ) {
        jQuery(this).fadeOut(); //if the click element is not the above id will hide
    }
})

<强>输出：

Answer 2

根据@Gurman的回复和@Ansgar Wiechers的评论，这里的代码更新效果非常好。谢谢你的帮助

Option Explicit
Dim File, objReg, strTest, RegExp, objMatches, objMatch, saveToFile, fso, outFile, strReplace, objShell, i
Set objShell = CreateObject("wscript.shell")
saveToFile = objShell.ExpandEnvironmentStrings("%windir%\Temp\test.txt")

Set File = CreateObject("MSXML2.XMLHTTP")
File.Open "GET","https://raw.githubusercontent.com/notracking/hosts-blocklists/master/domains.txt", False
File.send

If File.Status = 200 Then   

    '**********************************************************************************************
    ' Replace content for use with the file service.conf of soft Unbound_DNS
    '
    ' address=/abc.com/0.0.0.0      to      local-zone: "abc.com" redirect
    '                                       local-data: "abc.com 86400 IN A 0.0.0.0"
    '**********************************************************************************************
    strTest = File.responseText

    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.IgnoreCase = True
    RegExp.Global = True
    RegExp.Pattern = "address=/(.*?)/(\d{1,3}(?:\.\d{1,3}){3})" 
    strReplace = "local-zone: ""$1"" redirect" & vbCrLf & "local-data: ""$1 86400 IN A $2"""

    strTest = RegExp.Replace(strTest, strReplace)  
    Set RegExp = Nothing

    '**********************************************************************************************
    ' Write content 
    '**********************************************************************************************
    Set fso = CreateObject("scripting.filesystemobject")
    Set outFile = fso.OpenTextFile(saveToFile,2,True)
    outFile.Write strTest
    outFile.Close
End If

VBScript RegEx：替换内容

2 个答案: