来与大家分享。稍加改造就可以实现更强大的功能了。

用下面的代码就可以简单的批量导出picasa相册的外链了。

复制代码 代码如下:

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>

<%

dim xmlget,xmlhttp,email,paswd

email="youremail"'输入picasa的账户email

paswd="yourpassword"'输入picasa的密码

Set xmlhttp = CreateObject("Msxml2.ServerXMLHTTP")

With xmlhttp

.Open "GET", "https://www.google.com/accounts/ServiceLoginAuth?service=lh2&continue=http://picasaweb.google.com/lh/login?continue=http%3A%2F%

2Fpicasaweb.google.com%2Fhome<mpl=gp&h1=zh_CN&GALX=ip37cq7CgwE&Email="&email&"&Passwd="&paswd, False

'.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"

.Send ""

xmlget = getRedirect(bin2str(.responseBody))

.Open "GET", xmlget

.Send ""

xmlget = bin2str(.responseBody)

if request("type")="photo" then

.Open "GET", request("url")

.Send ""

xmlget = bin2str(.responseBody)

xmlget = Replace(xmlget, "pwa.setup", "test2")

else

xmlget = Replace(xmlget, "pwa.setup", "test")

end if

End With

set xmlhttp = nothing

Function bin2str(binstr)

Const adTypeBinary = 1

Const adTypeText = 2

Dim BytesStream,StringReturn

Set BytesStream = Server.CreateObject("ADODB.Stream")

With BytesStream

.Type = adTypeText

.Open

.WriteText binstr

.Position = 0

.Charset = "UTF-8"

.Position = 2

StringReturn = .ReadText

.Close

End With

Set BytesStream = Nothing

bin2str = StringReturn

End Function

Function getRedirect(str)

str = Mid(str, Instr(str, "location.replace"))

str = Mid(str, 19, Instr(str, """)")-19)

str = Replace(str, "x3d", "=")

getRedirect = Replace(str, "x26", "&")

End Function

%>

<%

if request("type")<>"photo" then

%>

<script language="javascript"><></script>

<%

else

%>

<script language="javascript"><></script>

<%

end if

%>

<%=xmlget%>

将上面的代码里picasa的用户名密码改好，保存成ASP文件，放到服务器下访问，就可以看到效果了。