本帖最后由 WHY 于 2018-7-27 21:45 编辑
2018-07-27 修改，增加 URL 转码（ANSI）- 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
| 
发表于 2018-7-24 21:19
| 
发表于 2018-7-25 13:47
| 