VBS脚本之短网址批量解析

乱码

今天看到两个帖子，《短网址生成器》和《求一个可以批量获得网页跳转为真实地址的软件》所以打算写个这个批量解析的VBS脚本、

Demon大侠写过一篇文章《VBS获取重定向的URL》里面深度剖析了如何用VBS取得HTTP 302重定向、
而短网址恰巧就是重定向的原理，所以"几乎"通杀。
当然也有例外，比如t.cn就比较变态，所以代码里做了特殊处理、

看效果图


好了下面放代码：

'脚本 : 短网址批量解析.vbs
'版本 : 1.0
'作者 : 乱码
'日期 : 2012-11-07
'源码献上，欢迎翻版。

CmdMode "短网址批量解析 v1.0   By.乱码","3f"
file="D:\url.txt" '需要解析的URL地址文件路径(支持相对路径)

Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
Set fso = CreateObject("Scripting.FileSystemObject")

http.Option(6) = False
Set fin = fso.OpenTextFile(file,1)
Set fout= fso.OpenTextFile(file&"_ok.txt",2,1)

WScript.Echo "开始处理，请骚等、、", vbCrLf
While Not fin.AtEndOfStream
    url = fin.ReadLine
    If url<>"" Then ret=getUrl(url) Else ret=""
    If ret<>"" Then
        If InStr(ret,"app/go/url.php?") Then ret = Mid(ret,44) '需特殊处理t.cn网址
        't.cn分多类情况，我没全面测试，如果出现错误，这行特殊处理代码删掉即可
        WScript.Echo url, "=>", ret
        fout.WriteLine ret
    End If
Wend
fin.Close
fout.Close

WScript.Echo ""
WScript.Echo "处理完成,已保存为", file&"_ok.txt"
WScript.StdIn.ReadLine

Function getUrl(url)
    On Error Resume Next
    If LCase(Left(url,7))<>"http://" Then url = "http://" & url
    http.Open "GET", url, False
    http.Send
    If Err Then
        WScript.Echo url, "解析遇到错误、、"
        Err.Clear
        getUrl = ""
    Else
        getUrl = http.GetResponseHeader("Location")
    End If
End Function

Function CmdMode(title, color)
    If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
        CreateObject("Wscript.Shell").Run "cmd /c title " & title & "&color " & color & "&Cscript //Nologo """ & WScript.ScriptFullName & """"
        WScript.Quit
    End If
End Function

url.txt 文件格式：

淡然出尘

湿傅 收了吧 可想学VBS 超帅！

19nuclear91

前十有我必火

hhyy540

这个很厉害啊

chinazhang

哦哦。错了。

chinazhang

我这里一直是解析错误啊。什么原因呢。

chinazhang

就这个。老是解析不成功

chinazhang

不是t.cn 的问题，我用http://dwz.cn/    这个测试也一样的效果啊。
这个附件是dwz.cn 的
也是一样的效果。

chinazhang

哥们，不行啊，我这里一直是解析错误，哪里的问题呢？
+ 191617  660

chinazhang

哦哦。找到问题了。我系统问题，我换到服务器上可以解析成功。 太厉害了。