[文本处理] Txt 提取链接到单独txt然后txt 每行前加文字另存txt

Dim fso, txt, reg, str

Set fso = CreateObject("Scripting.FileSystemObject")
txt = fso.OpenTextFile("1.txt", 1).ReadAll()

Set reg = New RegExp
reg.Global = True
reg.IgnoreCase = True
reg.MultiLine = True
reg.Pattern = "^(.*):\s*(https?://[^" + vbCrLf + "]+)"

For Each match In reg.Execute(txt)
    url = EncodeURL(match.SubMatches(1))
    str = str + "歌曲-" + match.SubMatches(0) + "." + GetShortURL(url) + vbCrLf
Next

Function EncodeURL(ByVal url)
    Dim Lens, i, n, s
    Lens = Len(url)
    For i = 1 To Lens
        s = Mid(url, i, 1)
        n = Asc(s)
        If (n >= 48 And n <= 57) Or (n >= 65 And n <= 90) Or (n >= 97 And n <= 122) Or n = 45 Or n = 46 Or n = 95 Then '[0-9A-Za-z\-._]
            EncodeURL = EncodeURL + s
        ElseIf n < 0 Then   '双字节
            EncodeURL = EncodeURL + "%" + Left(Hex(n), 2) + "%" + Right(Hex(n), 2)
        ElseIf n = 32 Then  '空格
            EncodeURL = EncodeURL + "+"
        Else
            EncodeURL = EncodeURL + "%" + Right("0" + Hex(n), 2)
        End If
    Next
End Function

Function GetShortURL(ByRef url)
    Dim xml
    Set xml = CreateObject("microsoft.xmlhttp")
    url = "http://api.rrd.me/api.php?url=" + url
    xml.open "GET", url, False
    xml.send()
    GetShortURL = xml.responseText
End Function

WSH.Echo str
复制代码