'Date: 2012/2/1
'Author: test
'Description: Youku rss calculator
Dim IE
Set IE = WScript.CreateObject("InternetExplorer.Application","IE_")
IE.Navigate "about:blank"
IE.ToolBar = False
IE.StatusBar = False
IE.Resizable = False
IE.Height = 180
IE.Width = 450
Set screen = IE.Document.parentWindow.screen
IE.Top = Int((screen.height - IE.Height) / 2)
IE.Left = Int((screen.width - IE.Width) / 2)
IE.Visible = True
With IE.Document
.writeln "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"
.writeln "<html xmlns=""http://www.w3.org/1999/xhtml"">"
.writeln "<head>"
.writeln "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />"
.writeln "<title>EditPlus Keygen</title>"
.writeln "</head>"
.writeln "<body>"
.writeln "<span>youku id url:</span><br />"
.writeln "<input name=""url"" type=""text"" id=""url"" size=""40"" />"
.writeln "<input type=""submit"" name=""calculate"" id=""calculate"" value=""calculate"" style=""width:75px;"" />"
.writeln "<br />"
.writeln "<span>RSS:</span><br />"
.writeln "<input name=""RSS"" type=""text"" id=""RSS"" size=""40"" readonly=""readonly"" />"
.writeln "<input type=""button"" name=""about"" id=""about"" value=""About..."" style=""width:75px;"" />"
.writeln "</body>"
.writeln "</html>"
End With
IE.Document.getElementById("calculate").onclick = GetRef("calculate_youku_rss")
IE.Document.getElementById("url").onkeyup = GetRef("calculate_youku_rss")
IE.Document.getElementById("about").onclick = GetRef("about")
Do
WScript.Sleep 1000
Loop
Sub IE_OnQuit()
WScript.Quit
End Sub
Sub about()
MsgBox "Copyright (c) 2012 ",vbInformation + vbSystemModal,"About"
End Sub
Sub calculate_youku_rss()
'http://u.youku.com/user_show/id_U base64(id*4) .html
'http://u.youku.com/user_show/id_UMjA5NjE2NDAw.html
'http://www.youku.com/user/rss/id/54824136
'http://u.youku.com/user_show/id_UMjE5Mjk2NTQ0.html
Dim url : url = Trim(IE.Document.getElementById("url").value)
Dim result
If url = "" Then
Exit Sub
IE.Document.getElementById("RSS").value = ""
End If
Set re = New RegExp
re.Pattern = "U(?:[A-Za-z0-9+/]{4})*(?:[A-Za-z0-9+/]{2}==|[A-Za-z0-9+/]{3}=)?" 'check base64 start with U
Set matches = re.Execute(url)
If matches.Count > 0 Then
Set match = matches(0)
msg = "Found match """ & match.Value & """ at position " & match.FirstIndex & vbCRLF
result = right(match.Value,12)
If match.SubMatches.Count > 0 Then
For I = 0 To match.SubMatches.Count-1
msg = msg & "Group #" & I+1 & " matched """ & _
match.SubMatches(I) & """" & vbCRLF
Next
End If
'msgbox msg, 0, ""
Else
msgbox "No match", 0, ""
End If
result = Base64Decode(result) / 4 'transform
IE.Document.getElementById("RSS").value = "http://www.youku.com/user/rss/id/"&result
End Sub
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
'remove white spaces, If any
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
' Now decode each group:
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
' Each data group encodes up To 3 actual bytes.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' Convert each character into 6 bits of data, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
'Hex splits the long To 6 groups with 4 bits
nGroup = Hex(nGroup)
'Add leading zeros
nGroup = String(6 - Len(nGroup), "0") & nGroup
'Convert the 3 byte hex integer (6 chars) To 3 characters
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2)))
'add numDataBytes characters To out string
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function
使用RSS阅读器订阅youku优酷视频更新以及专辑更新
http://plusium.wordpress.com/2010/11/24/rss_youku/
rss订阅youku会员视频
留言列表
創作 (2)
