我一直在研究vbscript，以tsv的形式从Google驱动器下载受密码保护的表格。我知道我的大多数代码都能正常工作，因为我使用它来下载不受Google驱动器保护的文件以及来自另一个站点的密码保护文件（该另一个站点已从我的代码示例中删除）。
我知道Google电子邮件和密码是正确的，因为当我将其从代码复制到浏览器会话时，我可以登录。-我从代码中删除了用户名和密码，以保护自己。我从Google收到的回复是电子邮件和密码不匹配。我想念什么？
编辑3/4/16
我不确定如何减少代码，因为对于希望运行它的任何人来说，它们都是互连的。我将两个新的/已编辑的功能（fParseGoogleLogin和fParseRedirect）推到了最顶端，这可能是问题的根源。fGetDataFromURL在获取HTTP状态302响应时调用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
今天再次尝试了上面的代码，并且可以正常工作-必须在某些地方缓存了某些内容。抱歉，添麻烦了。
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句