diff --git a/Source/Script/upload_beta.vbs b/Source/Script/upload_beta.vbs index 2c9bf4cc2..f8c7e237a 100644 --- a/Source/Script/upload_beta.vbs +++ b/Source/Script/upload_beta.vbs @@ -11,6 +11,7 @@ IE.Visible = True Login IE PostThread IE +IE.Quit Sub Wait(IE) Dim complete @@ -44,7 +45,7 @@ Sub Navigate(IE, url) End Sub Sub ValidateLoggedIn(IE) - WScript.StdOut.WriteLine "validate login success" + WScript.StdOut.WriteLine "ValidateLoggedIn start" Navigate IE, "http://forum.pj64-emu.com/" Wait IE @@ -67,9 +68,12 @@ Sub ValidateLoggedIn(IE) WScript.StdOut.WriteLine "Failed to login" WScript.Quit end if + WScript.StdOut.WriteLine "ValidateLoggedIn Done" End Sub Sub Login(IE) + On Error resume next + Set IE2 = WScript.CreateObject("InternetExplorer.Application", "IE_") IE2.Visible = True WScript.StdOut.WriteLine "Login start" @@ -78,10 +82,12 @@ Sub Login(IE) set navbar_username = IE2.document.getelementbyid("navbar_username") set navbar_password = IE2.document.getelementbyid("navbar_password") if navbar_username is nothing then + WScript.StdOut.WriteLine "Failed to find login form, checking if already logged in" ValidateLoggedIn IE exit sub end if + WScript.StdOut.WriteLine "Found login form" navbar_username.value = "buildbot" navbar_password.value = WScript.Arguments(0) navbar_username.form.submit @@ -89,9 +95,10 @@ Sub Login(IE) Dim FoundIt FoundIt = False + WScript.StdOut.WriteLine "Looking for redirect" For count = 0 to 100 - WScript.StdOut.WriteLine count Set NodeList = IE2.document.getElementsByTagName("a") + WScript.StdOut.WriteLine count & ": Found " & NodeList.length & " a tags" For Each Elem In NodeList if StrComp(Elem.href, "http://forum.pj64-emu.com/", vbTextCompare) = 0 then if StrComp(Elem.innerHTML, "Click here if your browser does not automatically redirect you.", vbTextCompare) = 0 then @@ -103,6 +110,7 @@ Sub Login(IE) if FoundIt = True then Exit For end if + WScript.Sleep 100 Next if FoundIt = false then @@ -123,7 +131,7 @@ End Sub Sub PostThread(IE) WScript.StdOut.WriteLine "PostThread start" - Navigate IE, "http://forum.pj64-emu.com/newthread.php?do=newthread&f=8" + Navigate IE, "http://forum.pj64-emu.com/newthread.php?do=newthread&f=10" Wait IE Set NodeList = IE.document.getElementsByTagName("input") @@ -142,17 +150,12 @@ Sub PostThread(IE) end if SetPostDetails IE, WScript.Arguments(2) + UploadFile WScript.Arguments(1) - set manage_attachments_button = ie.document.getelementbyid("manage_attachments_button") - if not manage_attachments_button is nothing then - manage_attachments_button.click - Wait IE - WScript.Sleep 2000 - UploadFile WScript.Arguments(1) - end if - + WScript.StdOut.WriteLine "submitting" submitButton.click - Wait IE + Wait IE + WScript.StdOut.WriteLine "PostThread Finished" End Sub Sub SetPostDetails(IE, BuildUrl) @@ -249,81 +252,119 @@ end sub sub UploadFile(FileToUpload) WScript.StdOut.WriteLine "UploadFile start" - On Error resume next - set IE = Nothing + dim filePos + filePos = InStrRev(FileToUpload, "\") + if filePos = 0 then + WScript.StdOut.WriteLine "failed to find directory seperator in " & FileToUpload + WScript.Quit + end if - Set Shell = CreateObject("Shell.Application") - For i = 0 to Shell.Windows.Count -1 - set Win = Shell.Windows.Item(i) - If TypeName(win.Document) = "HTMLDocument" Then - if StrComp(win.Document.title, "Manage Attachments - Project64 Forums", vbTextCompare) = 0 then - set IE = win - end if - End If + dim fileName + fileName = Mid(FileToUpload, filePos + 1, len(FileToUpload)) + WScript.StdOut.WriteLine fileName - if not IE is nothing then - exit for - end if - Next - if IE is nothing then - WScript.StdOut.WriteLine "Failed to find upload window" - exit sub + extPos = InStrRev(fileName, ".") + if extPos = 0 then + WScript.StdOut.WriteLine "failed to find file extension in " & fileName + WScript.Quit + end if + extension = Mid(fileName, extPos, len(fileName)) + if lcase(extension) <> ".zip" then + WScript.StdOut.WriteLine "not a zip file: " & fileName + WScript.Quit + end if + + + set manage_attachments_button = ie.document.getelementbyid("manage_attachments_button") + if manage_attachments_button is nothing then + WScript.StdOut.WriteLine "failed to find manage_attachments_button" + WScript.Quit end if - WScript.StdOut.WriteLine "Found window" - Set objShell = CreateObject("Wscript.Shell") - WScript.StdOut.WriteLine "activate: " & win.Document.title & " - " & IE.name - Dim activated - For count = 0 to 100 - activated = objShell.AppActivate(win.Document.title & " - " & IE.name, True) - if activated then - exit for - end if - WScript.StdOut.WriteLine count & ": " & activated - WScript.Sleep 100 - Next - - if not activated then - WScript.StdOut.WriteLine "Failed to activate window" + WScript.StdOut.WriteLine "InStr(1, lcase(manage_attachments_button.onclick), ""vb_attachments"") = " & InStr(1, lcase(manage_attachments_button.onclick), "vb_attachments") + dim startPos, endPos + startPos = InStr(1, lcase(manage_attachments_button.onclick), "vb_attachments") + if startPos = 0 then + WScript.StdOut.WriteLine "failed to find vb_attachments in " & manage_attachments_button.onclick + WScript.Quit + end if + startPos = InStr(startPos, lcase(manage_attachments_button.onclick), "'") + if startPos = 0 then + WScript.StdOut.WriteLine "failed to find first quote in " & manage_attachments_button.onclick + WScript.Quit + end if + startPos = startPos + 1 + endPos = InStr(startPos,manage_attachments_button.onclick, "'") + if endPos = 0 then + WScript.StdOut.WriteLine "failed to find second quote in " & manage_attachments_button.onclick + WScript.Quit + end if + + Set IE2 = WScript.CreateObject("InternetExplorer.Application", "IE_") + IE2.Visible = True + Navigate IE2, "http://forum.pj64-emu.com/" & Mid(manage_attachments_button.onclick, startPos, endPos - startPos) + Wait IE2 + + Set FormList = IE2.document.getElementsByTagName("form") + if FormList.length <> 1 or FormList(0).name <> "newattachment" then + WScript.StdOut.WriteLine "failed to find attachement form" WScript.Quit end if - Set NodeList = IE.document.getElementsByTagName("input") - For Each Elem In NodeList - if StrComp(Elem.name, "attachment[]", vbTextCompare) = 0 then - Elem.focus() - objShell.SendKeys " " - - WScript.StdOut.WriteLine "Uploading: " & FileToUpload - Wscript.Sleep 1000 - a=Split(FileToUpload,"\") - b=ubound(a) - For i=0 to b - objShell.SendKeys a(i) - if i < b then - objShell.SendKeys "\" - else - objShell.SendKeys "{ENTER}" - end if - Wscript.Sleep 100 - Next - exit for - end if - Next + Set InputList = FormList(0).getElementsByTagName("input") + WScript.StdOut.WriteLine "InputList.length = " & InputList.length - For Each Elem In NodeList - if StrComp(Elem.name, "upload", vbTextCompare) = 0 then - Elem.click - Wait IE - exit for + dim PreFormData, PostFormData + + For Each Input In InputList + if lcase(Input.type) = "hidden" then + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""" & Input.name & """" & vbCrLf & vbCrLf & Input.value& vbCrLf end if - Next + WScript.StdOut.WriteLine "Input.type: " & Input.type & " Input.name: " & Input.name & " Input.value: " & Input.value + next + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""attachment[]""; filename=""" & fileName & """" & vbCrLf + PreFormData = PreFormData & "Content-Type: application/zip" & vbCrLf & vbCrLf + PostFormData = vbCrLf & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""upload""" & vbCrLf & vbCrLf & "Upload" & vbCrLf + PostFormData = PostFormData & vbCrLf & vbCrLf & "--AaB03x--"& vbCrLf + WScript.StdOut.WriteLine PreFormData & PostFormData + + dim fileContents + fileContents = ReadBinaryFile(FileToUpload) + + dim UploadUrl + UploadUrl = "http://forum.pj64-emu.com/" & FormList(0).action + IE2.Quit + + Header = "Content-Type: multipart/form-data; boundary=AaB03x" & vbCrLf + + Const adTypeBinary = 1 + + Dim DataToPOSTStream + Set DataToPOSTStream = CreateObject("ADODB.Stream") + + DataToPOSTStream.type=adTypeBinary + DataToPOSTStream.Open + + DataToPOSTStream.Write = Stream_StringToBinary(PreFormData,"us-ascii") + DataToPOSTStream.Write = fileContents + DataToPOSTStream.Write = Stream_StringToBinary(PostFormData,"us-ascii") + DataToPOSTStream.Position = 0 + DataToPOSTStream.Type = adTypeBinary + Dim DataToPOST + DataToPOST = DataToPOSTStream.Read + + Set IE3 = WScript.CreateObject("InternetExplorer.Application") + IE3.Visible = 1 + WScript.StdOut.WriteLine "Navigating to: " & UploadUrl + IE3.Navigate UploadUrl, Nothing, Nothing, DataToPOST, Header + Wait IE3 + Dim UploadDone UploadDone = False For count = 0 to 1000 WScript.StdOut.WriteLine count & ": Waiting for upload done" - Set NodeList = ie.document.getElementsByTagName("legend") + Set NodeList = IE3.document.getElementsByTagName("legend") For Each Elem In NodeList if (len(Elem.innerHTML) > 19) and lcase(Mid(Elem.innerHTML, 1, 19)) = "current attachments" then UploadDone = true @@ -340,13 +381,45 @@ sub UploadFile(FileToUpload) WScript.StdOut.WriteLine "Failed to upload file" WScript.Quit end if + IE3.Quit - Set NodeList = IE.document.getElementsByTagName("input") - For Each Elem In NodeList - if lcase(Elem.value) = "close this window" then - Elem.click - exit for - end if - Next + WScript.StdOut.WriteLine "UploadFile Finished" end sub +Function Stream_StringToBinary(Text, CharSet) + Const adTypeText = 2 + Const adTypeBinary = 1 + + Dim BinaryStream + Set BinaryStream = CreateObject("ADODB.Stream") + + BinaryStream.Type = adTypeText + BinaryStream.CharSet = CharSet + + BinaryStream.Open + BinaryStream.WriteText Text + + BinaryStream.Position = 0 + BinaryStream.Type = adTypeBinary + Stream_StringToBinary = BinaryStream.Read + + Set BinaryStream = Nothing +End Function + +Function ReadBinaryFile(path) + Const adTypeText = 2 + Const adTypeBinary = 1 + + dim inStream + dim myByte,myByteValue,myCharacter + + set inStream=WScript.CreateObject("ADODB.Stream") + + inStream.Open + inStream.type=1 + + inStream.LoadFromFile path + + ReadBinaryFile=inStream.Read() + inStream.Close +End Function