我一直在使用vbscript从google驱动器下载受密码保护的表格作为tsv。我知道我的大部分代码都有效，因为我使用它来下载不受谷歌驱动器保护的文件以及来自其他站点的密码保护文件（另一个站点已从我的代码示例中删除）。
我知道google电子邮件和密码是正确的，因为当我将它们从我的代码复制到浏览器会话时，我可以登录。 - 我从我的代码中删除了用户名和密码以保护自己。我从谷歌回复的回复是电子邮件和密码不匹配。我错过了什么？
编辑3/4/16
我不确定如何减少代码，因为对于任何希望尝试运行代码的人而言，它都是相互关联的。我将两个新的/编辑过的函数（可能是问题的根源）提升到顶部（fParseGoogleLogin和fParseRedirect）。在获取HTTP状态302响应时，fGetDataFromURL调用fParseRedirect。
代码说明3/4/16
这预先假定文件夹c：\ users * username * \ appdataroaming \ pdiList已经存在
您需要使用自己的Google用户名（strGoogleEmail），密码（strGooglePass）和文件（urlMainTable）进行测试。我在urlMainTable中留下了一个值作为参考，但它确实包含了无法在我公司外部共享的敏感数据。
sWriteWebData子程序将一切都关闭 - 将url传递给fGetDataFromURL并将最终文件写入光盘。
fGetDataFromURL传递给其他函数进行读取（fLoadCookies）和编写cookie（fParseResponseForCookies）和处理重定向（fParseRedirect）
我遇到的问题再一点是，使用此代码，我收到的页面显示我的密码与电子邮件地址不符。但是，当从此代码复制到Web浏览器中的登录页面时，用户名和密码才起作用。
OPTION EXPLICIT
DIM urlMainTable, nameMainTable, strGoogleEmail, strGooglePass
strGoogleEmail =
strGooglePass=
urlMainTable = "https://docs.google.com/spreadsheets/d/1OCdhjjRSE4QsrngH0LJzM6IaFU1ZFpl9DZSjdINotYg/export?format=tsv&id=1OCdhjjRSE4QsrngH0LJzM6IaFU1ZFpl9DZSjdINotYg&gid=1439665763"
nameMainTable = "MainTable.tsv"
sWriteWebData urlMainTable, nameMainTable
Function fParseRedirect(blobHeader)
DIM strLocation, lenLocation, iLocationHeader, urlRedirect, startRedirect, endRedirect, bolGoogleLogin
bolGoogleLogin = FALSE
strLocation = "Location: "
lenLocation = len(strLocation)
iLocationHeader = InStr(blobHeader, strLocation)
startRedirect = iLocationHeader + lenLocation
endRedirect = InStr(startRedirect, blobHeader, vbCrLf)-startRedirect
If iLocationHeader Then
urlRedirect = MID(blobHeader, startRedirect, endRedirect)
If InStr(urlRedirect, "google.com/accounts/ServiceLogin") Then
bolGoogleLogin = TRUE
End If
fParseRedirect = fGetDataFromURL(urlRedirect, "GET", "")
If bolGoogleLogin Then fParseRedirect = fParseGoogleLogin(fParseRedirect, urlRedirect)
End If
End Function
Function fParseGoogleLogin(blobResponseBody, urlForm)
DIM iResponseBody, dictPOSTData, strKey, strPostData
DIM iEndDomain, urlFormPost, bolSubmitAgain, blobResponse
DIM iFormActionStart, strFormAction, iFormActionEnd
DIM strNameStart, lenNameStart, iNameStart, iNameEnd, strName
DIM strValueStart, lenValueStart, iValueStart, iValueEnd, strValue
Set dictPOSTData = CreateObject("Scripting.Dictionary")
dictPOSTData.Add "Page", "PasswordSeparationSignIn"
If (InStr(blobResponseBody, strGoogleEmail)) Then
dictPOSTData.Add "Passwd", strGooglePass
bolSubmitAgain = False
Else
bolSubmitAgain = True
End If
dictPOSTData.Add "Email", strGoogleEmail
iEndDomain = InStr(InStr(urlForm, "://")+3, urlForm, "/")-1
urlForm = left(urlForm, iEndDomain)
strFormAction = "<form novalidate method=""post"" action="""
iFormActionStart = InStr(blobResponseBody, strFormAction)+len(strFormAction)
iFormActionEnd = InStr(iFormActionStart, blobResponseBody, """") - iFormActionStart
' urlFormPost = urlForm & Mid(blobResponseBody, iFormActionStart, iFormActionEnd)
urlFormPost = Mid(blobResponseBody, iFormActionStart, iFormActionEnd)
iResponseBody = InStr(blobResponseBody, "<input type=""hidden""")
Do Until iResponseBody = 0
strNameStart = "name="""
lenNameStart = len(strNameStart)
iNameStart = InStr(iResponseBody, blobResponseBody, strNameStart) + lenNameStart
iNameEnd = InStr(iNameStart, blobResponseBody, """") - iNameStart
strName = Mid(blobResponseBody, iNameStart, iNameEnd)
strValueStart = "value="""
lenValueStart = len(strValueStart)
iValueStart = InStr(iResponseBody, blobResponseBody, strValueStart) + lenValueStart
iValueEnd = InStr(iValueStart, blobResponseBody, """") - iValueStart
strValue = Mid(blobResponseBody, iValueStart, iValueEnd)
dictPOSTData.Add strName, strValue
iResponseBody = InStr(iValueStart, blobResponseBody, "<input type=""hidden""")
Loop
iResponseBody = InStr(blobResponseBody, "<input id=""profile-information""")
Do Until iResponseBody = 0
strNameStart = "name="""
lenNameStart = len(strNameStart)
iNameStart = InStr(iResponseBody, blobResponseBody, strNameStart) + lenNameStart
iNameEnd = InStr(iNameStart, blobResponseBody, """") - iNameStart
strName = Mid(blobResponseBody, iNameStart, iNameEnd)
strValueStart = "value="""
lenValueStart = len(strValueStart)
iValueStart = InStr(iResponseBody, blobResponseBody, strValueStart) + lenValueStart
iValueEnd = InStr(iValueStart, blobResponseBody, """") - iValueStart
strValue = Mid(blobResponseBody, iValueStart, iValueEnd)
dictPOSTData.Add strName, strValue
iResponseBody = InStr(iValueStart, blobResponseBody, "<input id=""profile-information""")
Loop
For Each strKey in dictPOSTData
strPOSTData = strPOSTData & strKey &"="& dictPOSTData(strKey) &"&"
Next
strPOSTData = Left(strPOSTData, len(strPOSTData)-1)
If bolSubmitAgain Then
blobResponse = fParseGoogleLogin(fGetDataFromURL(urlFormPost, "POST", strPOSTData), urlFormPost)
Else
blobResponse = fGetDataFromURL(urlFormPost, "POST", strPOSTData)
End If
fParseGoogleLogin = blobResponse
End Function
Sub sWriteWebData(strURL, strWriteFile)
DIM strData, objFSO, objTSVFile
strData = fGetDataFromURL(strURL, "GET", "")
If strData <> "DLFail" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTSVFile = objFSO.CreateTextFile(strWriteFile, TRUE)
objTSVFile.Write(strData)
objTSVFile.Close
End If
End Sub
Function fLoadCookies(strRequestURL)
DIM objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
DIM objShell
Set objShell = Wscript.CreateObject("Wscript.Shell")
DIM pathAppDataRoaming, pathPDIListData
pathAppDataRoaming=objShell.ExpandEnvironmentStrings("%APPDATA%")
pathPDIListData = pathAppDataRoaming & "\PDIList"
DIM fileCookies, strResponseDomain, pathCookieFile
strResponseDomain = fGetDomain(strRequestURL)
pathCookieFile = pathPDIListData & "\" & strResponseDomain & ".txt"
If NOT objFSO.FileExists(pathCookieFile) Then Exit Function
Set fileCookies = objFSO.OpenTextFile(pathCookieFile)
DIM dictCookies, strCookie, strCookieKey
Set dictCookies = CreateObject("Scripting.Dictionary")
Do While NOT fileCookies.AtEndOfStream
strCookie = fileCookies.ReadLine
If len(strCookie) > 1 Then
strCookieKey = fGetCookieKey(strCookie)
dictCookies.Add strCookieKey, strCookie
End If
Loop
Set fLoadCookies = dictCookies
End Function
Function fGetDomain(strURL)
DIM nEndDomain, strHost, nStartDomain, lenDomain
lenDomain= len(strURL)
nStartDomain = Instr(strURL, "://") +2
strHost = right(strURL, lenDomain-nStartDomain)
nEndDomain = InStr(strHost, "/")
If nEndDomain Then strHost = left(strHost, nEndDomain-1)
DIM objRegEx, matches, match
Set objRegEx = New RegExp
objRegEx.Pattern = "^(.*?)\.?([^.]+)\.(\w{2,}|\w{2}\.\w{2})$"
Set matches = objRegEx.Execute(strHost)
If matches.count = 1 Then
Set match = matches(0)
fGetDomain = match.SubMatches(1) & "." & match.SubMatches(2)
End If
End Function
Function fGetDataFromURL(strURL, strMethod, strPostData)
msgbox strPostData
DIM lngTimeout, strUserAgentString, intSslErrorIgnoreFlags, blnEnableRedirects
DIM blnEnableHttpsToHttpRedirects, strHostOverride, strLogin, strPassword, strResponseText, objWinHttp
DIM iCookies, strCookie
DIM dictCookies
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = False
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If IsObject(fLoadCookies(strURL)) Then
Set dictCookies = fCheckCookiesExpired(fLoadCookies(strURL))
DIM itemsDict, bolDomainPathOK
itemsDict = dictCookies.Items
For iCookies = 0 To dictCookies.Count -1 ' Iterate the array.
bolDomainPathOK = TRUE
strCookie = itemsDict(iCookies)
If InStr(strCookie, ";") Then
bolDomainPathOK = fBolDomainPathOK(strCookie, strURL)
strCookie = Left(strCookie, InStr(strCookie, ";")-1)
End If
If bolDomainPathOK Then objWinHttp.setRequestHeader "Cookie", strCookie ' Set the Cookie into the request headers
Next
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
Set dictCookies = fParseResponseForCookies(objWinHttp.GetAllResponseHeaders, strURL, dictCookies)
If objWinHttp.Status = "200" Then
On Error GoTo 0
fGetDataFromURL = objWinHttp.ResponseText
ElseIf objWinHTTP.Status = "302" Then
On Error GoTo 0
fGetDataFromURL = fParseRedirect(objWinHTTP.GetAllResponseHeaders)
Else
fGetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
fGetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
End Function
Function fBolDomainPathOK(strCookie, urlRequest)
If InStr(urlRequest, "?") Then
urlRequest = Left(urlRequest, InStr(urlRequest, "?")-1)
End If
DIM strDomainStart, lenDomainStart, strDomain
DIM startDomain, endDomain, iDomain, bolDomainOK
strDomainStart = "Domain=."
lenDomainStart = Len(strDomainStart)
iDomain = InStr(1, strCookie, strDomainStart, VBTEXTCOMPARE)
If iDomain Then
startDomain = iDomain+lenDomainStart
endDomain = InStr(startDomain, strCookie, ";")-startDomain
If endDomain > 0 Then
strDomain = Mid(strCookie, startDomain, endDomain)
Else
strDomain = Mid(strCookie, startDomain)
End If
If InStr(1, urlRequest, strDomain, VBTEXTCOMPARE) Then
bolDomainOK = TRUE
Else
bolDomainOK = FALSE
End If
Else
bolDomainOK = TRUE
End If
DIM strPathStart, lenPathStart, strPath
DIM startPath, endPath, iPath, bolPathOK
strPathStart = "Path="
lenPathStart = len(strPathStart)
iPath = InStr(1, strCookie, strPathStart, VBTEXTCOMPARE)
If iPath Then
startPath = iPath+lenPathStart
endPath = InStr(startPath, strCookie, ";")-startPath
If endPath > 0 Then
strPath = Mid(strCookie, startPath, endPath)
Else
strPath = Mid(strCookie, startPath)
End If
If InStr(1, urlRequest, strPath, VBTEXTCOMPARE) Then
bolPathOK = TRUE
Else
bolPathOK = FALSE
End If
Else
bolPathOK = TRUE
End If
If bolPathOK AND bolDomainOK Then
fBolDomainPathOK = TRUE
Else
fBolDomainPathOK = FALSE
End If
End Function
Function fGetCookieKey(strCookie)
fGetCookieKey = left(strCookie, inStr(strCookie, "=")-1)
End Function
Function fParseResponseForCookies(strHeaders, strResponseURL, dictCookies)
DIM arrHeaders, strHeader
DIM objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
DIM objShell
Set objShell = Wscript.CreateObject("Wscript.Shell")
DIM pathAppDataRoaming, pathPDIListData
pathAppDataRoaming=objShell.ExpandEnvironmentStrings("%APPDATA%")
pathPDIListData = pathAppDataRoaming & "\PDIList"
DIM fileCookies, strResponseDomain, pathCookieFile
strResponseURL = Replace(strResponseURL, ":443", "")
strResponseDomain = fGetDomain(strResponseURL)
pathCookieFile = pathPDIListData & "\" & strResponseDomain & ".txt"
DIM strCookiePrefix, lenCookiePrefix, lenCookie, strCookie, strCookieKey, bolCookieObject
strCookiePrefix = "Set-Cookie: "
lenCookiePrefix = len(strCookiePrefix)
arrHeaders = Split(strHeaders, vbCrLf)
For Each strHeader in arrHeaders
If InStr(strHeader, strCookiePrefix) Then
lenCookie = len(strHeader) - lenCookiePrefix
strCookie = right(strHeader, lenCookie)
If fBolCookieDomainOK(strCookie, strResponseDomain) Then
strCookieKey=fGetCookieKey(strCookie)
If NOT isObject(dictCookies) Then Set dictCookies = CreateObject("Scripting.Dictionary")
If dictCookies.Exists(strCookieKey) Then
dictCookies(strCookieKey) = strCookie
Else
dictCookies.Add strCookieKey, strCookie
End If
End If
End If
Next
If isObject(dictCookies) Then
Set dictCookies = fCheckCookiesExpired(dictCookies)
DIM itemsDict, iCookies
itemsDict = dictCookies.Items
msgbox pathCookieFile
Set fileCookies = objFSO.CreateTextFile(pathCookieFile)
For iCookies = 0 To dictCookies.Count -1 ' Iterate the array.
fileCookies.WriteLine(itemsDict(iCookies)) ' Return results.
Next
fileCookies.Close
End If
Set fParseResponseForCookies = dictCookies
End Function
Function fBolCookieDomainOK(strCookie, strDomain)
DIM strCookieDomainStart, lenCookieDomainStart, strCookieDomain
DIM startCookieDomain, endCookieDomain, iCookieDomain, bolCookieDomainOK
strCookieDomainStart = "Domain=."
lenCookieDomainStart = Len(strCookieDomainStart)
iCookieDomain = InStr(1, strCookie, strCookieDomainStart, VBTEXTCOMPARE)
If iCookieDomain Then
startCookieDomain = iCookieDomain+lenCookieDomainStart
endCookieDomain = InStr(startCookieDomain, strCookie, ";")-startCookieDomain
If endCookieDomain > 0 Then
strCookieDomain = Mid(strCookie, startCookieDomain, endCookieDomain)
Else
strCookieDomain = Mid(strCookie, startCookieDomain)
End If
If InStr(1, strCookieDomain, strDomain, VBTEXTCOMPARE) Then
bolCookieDomainOK = TRUE
Else
bolCookieDomainOK = FALSE
End If
Else
bolCookieDomainOK = TRUE
End If
fBolCookieDomainOK = bolCookieDomainOK
End Function
Function fCheckCookiesExpired(dictCookies)
DIM strExpires, iExpires, dtExpires, lenExpires
DIM strCookie, key, bolSession, startDT, endDT
strExpires= "Expires="
lenExpires = Len(strExpires)
For Each key in dictCookies
strCookie = dictCookies(key)
iExpires = InStr(strCookie, strExpires)
If iExpires Then
startDT = iExpires+lenExpires
endDT = InStr(startDT, strCookie, ";")-startDT
If endDT > 0 Then
dtExpires = Mid(strCookie, startDT, endDT)
Else
dtExpires = Mid(strCookie, startDT)
End If
If InStr(dtExpires, "GMT") Then
dtExpires = dateTimeFromRFC1123(dtExpires)
bolSession = False
Else
bolSession = True
End If
If DateDiff("S", dtExpires, now()) > 0 Then
dictCookies.Remove(key)
ElseIf bolSession Then
strCookie = Replace(strCookie, dtExpires, DateAdd("N", 10, Now()))
dictCookies.Item(key) = strCookie
End If
Else
strCookie = strCookie & "; Expires=" & DateAdd("N", 10, Now())
dictCookies.Item(key) = strCookie
End If
Next
Set fCheckCookiesExpired = dictCookies
End Function
function dateTimeToRFC1123 (dt_dateTime)
dim a_shortDay, a_shortMonth
dt_dateTime = dateAdd ("N", createObject ("WScript.Shell").regRead ("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") , dt_dateTime)
a_shortDay = array ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
a_shortMonth = array ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
dateTimeToRFC1123 = a_shortDay (weekDay (dt_dateTime) - 1) & ","
dateTimeToRFC1123 = dateTimeToRFC1123 & " " & right ("0" & day (dt_dateTime) , 2) & " " & a_shortMonth (month (dt_dateTime) - 1) & " " & year (dt_dateTime)
dateTimeToRFC1123 = dateTimeToRFC1123 & " " & right ("0" & hour (dt_dateTime) , 2) & ":" & right ("0" & minute (dt_dateTime) , 2) & ":" & right ("0" & second (dt_dateTime) , 2) & " GMT"
end function
function dateTimeFromRFC1123 (s_dateTime)
dateTimeFromRFC1123 = cdate (mid (s_dateTime, 6, len (s_dateTime) - 9) )
dateTimeFromRFC1123 = dateAdd ("N", - createObject ("WScript.Shell").regRead ("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") , dateTimeFromRFC1123)
end function
答案 0 :(得分：0)
今天再次尝试上面的代码并且它有效 - 一定是在某处缓存的东西。抱歉，麻烦。