From a61557a317fa0fe5bcb4aec5ec3dd8e8e43fd287 Mon Sep 17 00:00:00 2001 From: zilmar Date: Fri, 30 Jun 2017 17:15:52 +1000 Subject: [PATCH] [Project64] Add new upload_beta script --- Source/Script/upload_beta.vbs | 546 ++++++++-------------------------- 1 file changed, 123 insertions(+), 423 deletions(-) diff --git a/Source/Script/upload_beta.vbs b/Source/Script/upload_beta.vbs index d528a053d..c8c96818a 100644 --- a/Source/Script/upload_beta.vbs +++ b/Source/Script/upload_beta.vbs @@ -1,286 +1,63 @@ -' On Error Resume Next +if WScript.Arguments.Count < 3 then + ShowUsage() +ElseIf StrComp("--create",WScript.Arguments(0)) = 0 Then + if WScript.Arguments.Count < 4 then + ShowUsage() + else + CreateUploadTarget() + end if +ElseIf StrComp("--files",WScript.Arguments(0)) = 0 Then + if WScript.Arguments.Count < 4 then + ShowUsage() + else + UploadFiles() + end if +Else + ShowUsage() +End if -if WScript.Arguments.Count < 4 then - WScript.StdOut.WriteLine "Missing parameters" - WScript.StdOut.WriteLine "[password] [file to upload] [BuildUrl] [Posttitle]" +sub ShowUsage() + WScript.StdOut.WriteLine "incorrect parameters" + WScript.StdOut.WriteLine "--create [password] [BuildUrl] [BuildName]" + WScript.StdOut.WriteLine "--files [password] [dir to upload] [BuildName]" WScript.Quit 1 -end if +end sub -Set IE = CreateIeWindow() -WScript.StdOut.WriteLine IE.HWND -IE.Visible = True - -Login IE -PostThread IE -IE.Quit -WScript.Quit 0 - -function CreateIeWindow () - on error resume next - - Set CreateIeWindow = nothing - For count = 0 to 100 - WScript.StdOut.WriteLine count & ": Trying to create Internet Explorer" - Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_") - if not IE is nothing then - WScript.StdOut.WriteLine count & ": Created Internet Explorer" - WScript.StdOut.WriteLine IE.HWND - IE.Visible = True - - WScript.StdOut.WriteLine IE.HWND - Set CreateIeWindow = IE - exit for - end if - WScript.StdOut.WriteLine count & ": Not created" - WScript.Sleep 100 - WScript.StdOut.WriteLine count & ": Should loop" - Next - if CreateIeWindow is nothing then - WScript.StdOut.WriteLine "Failed to create InternetExplorer.Application" - WScript.Quit 1 - end if +function Project64Url() + Project64Url = "http://www.local.pj64-emu.com" End Function -Sub Wait(IE) - Dim complete - complete = False +sub CreateUploadTarget() + dim BuildUrl + BuildUrl = WScript.Arguments(2) - WScript.StdOut.WriteLine "Waiting for IE" - - For count = 0 to 1000 - WScript.StdOut.WriteLine "before sleep" - WScript.Sleep 100 - WScript.StdOut.WriteLine "after sleep" - if IE is nothing then - WScript.StdOut.WriteLine "after sleep" - end if - WScript.StdOut.WriteLine count & ": IE.readyState: " & IE.readyState - if IE.readyState >= 4 then - WScript.StdOut.WriteLine count & ": IE.Busy: " & IE.Busy - if not IE.Busy then - WScript.StdOut.WriteLine count & ": IE.document.readyState: " & IE.document.readyState - if StrComp(IE.document.readyState, "complete", vbTextCompare) = 0 then - complete = true - exit for - end if - end if - end if - Next - - if not complete then - WScript.StdOut.WriteLine "Failed to wait for IE" + Dim objHTTP + Set objHTTP = CreateObject("MSXML2.XMLHTTP") + objHTTP.open "GET", BuildUrl & "buildTimestamp", False + objHTTP.send + if (objHTTP.status <> 200) then + WScript.StdOut.WriteLine "failed to get job timestamp (" & BuildUrl & "buildTimestamp)" WScript.Quit 1 end if - WScript.StdOut.WriteLine "IE Done" -End Sub + dim d -Function FindIeWindow(ieID) - on error resume next - set IE = nothing - - For count = 0 to 100 - Set Shell = CreateObject("Shell.Application") - For i = 0 to Shell.Windows.Count -1 - set Win = Shell.Windows.Item(i) - WScript.StdOut.WriteLine i & ": " & TypeName(win.Document) - - If TypeName(win.Document) = "HTMLDocument" Then - WScript.StdOut.WriteLine "uniqueID: @" & win.HWND & "@" & ieID & "@" - if win.HWND = ieID then - WScript.StdOut.WriteLine "matched" - set IE = win - end if - End If - if not IE is nothing then - exit for - end if - Next - if not IE is nothing then - exit for - end if - WScript.StdOut.WriteLine count & ": failed, trying again" - WScript.Sleep 100 - Next - set FindIeWindow = IE - - if IE is nothing then - WScript.StdOut.WriteLine "Failed to find navigating window" - else - WScript.StdOut.WriteLine "HWND : " & IE.HWND - end if -End Function - -Sub Navigate(IE, url) - dim ieId - ieID = IE.HWND - WScript.StdOut.WriteLine "Navigating (" & IE.HWND & ") to: " & url - IE.Navigate url - WScript.Sleep 100 - ' set IE = FindIeWindow(ieID) - Wait IE -End Sub - -Sub ValidateLoggedIn(IE) - WScript.StdOut.WriteLine "ValidateLoggedIn - 1" - WScript.StdOut.WriteLine "ValidateLoggedIn start" - WScript.StdOut.WriteLine "ValidateLoggedIn - 2" - Navigate IE, "http://forum.pj64-emu.com/" - WScript.StdOut.WriteLine "ValidateLoggedIn - 3" - Wait IE - WScript.StdOut.WriteLine "ValidateLoggedIn - 4" - - Dim LoggedIn - LoggedIn = False - WScript.StdOut.WriteLine "ValidateLoggedIn - 5" - Set NodeList = IE.document.getElementsByTagName("a") - WScript.StdOut.WriteLine "ValidateLoggedIn - 6" - WScript.StdOut.WriteLine "Got Node list" - For Each Elem In NodeList - WScript.StdOut.WriteLine Elem.href - if lcase(Mid(Elem.href,1,39)) = "http://forum.pj64-emu.com/member.php?u=" then - if lcase(Mid(Elem.parentElement.innerHTML,1,11)) = "welcome, 200) then + SetLocale 1033 + build_date=CDate(objHTTP.responseText) + + Set objHTTP = CreateObject("MSXML2.XMLHTTP") + objHTTP.open "GET", BuildUrl & "api/xml?wrapper=changes", False + objHTTP.send + + if (objHTTP.status <> 200) then WScript.StdOut.WriteLine "failed to get job details (" & BuildUrl & "api/xml?wrapper=changes)" WScript.Quit 1 end if - Dim xmlDoc - Set xmlDoc = oReq.responseXML + Dim xmlDoc + Set xmlDoc = objHTTP.responseXML Set objLst = xmlDoc.getElementsByTagName("freeStyleBuild") - Dim PostContent + Dim ProductDescription For each elem in objLst set childNodes = elem.childNodes for each node in childNodes @@ -301,70 +78,61 @@ Sub SetPostDetails(IE, BuildUrl, PostTitle) next if (Len(comment) > 0 and Len(commitId) > 0) then - PostContent = PostContent & "[*]" & comment & " (commit: [URL=""https://github.com/project64/project64/commit/" & commitId & """]"& commitId & "[/URL])" & vbCr + ProductDescription = ProductDescription & "[*]" & comment & " (commit: [URL=""https://github.com/project64/project64/commit/" & commitId & """]"& commitId & "[/URL])" & vbCrLf end if next end if next Next - - if (Len(PostContent) > 0) then - PostContent = "Changes:"&vbCr&"[LIST=1]" & vbCr & PostContent & "[/LIST]" + if (Len(ProductDescription) > 0) then + ProductDescription = "Changes:"&vbCrLf&"[LIST]" & vbCrLf & ProductDescription & "[/LIST]" else - PostContent = "No code changes" + ProductDescription = "No code changes" end if + + Dim url + url = Project64Url() + "/index.php" - WScript.StdOut.WriteLine "PostTitle = """ & PostTitle & """" - WScript.StdOut.WriteLine "PostContent = """ & PostContent & """" + dim data + data = "option=com_betafile" + data = data & "&task=CreateProduct" + data = data & "&password="&WScript.Arguments(1) + data = data & "&jform[product_name]="&WScript.Arguments(3) + data = data & "&jform[product_desc]="&ProductDescription + data = data & "&jform[product_date]="&Year(build_date) & "-" & Month(build_date) & "-" & Day(build_date) + + Set objHTTP = CreateObject("Microsoft.XMLHTTP") + objHTTP.open "POST", url, False - Dim SetTitle - SetTitle = False - Set NodeList = IE.document.getElementsByTagName("input") - For Each Elem In NodeList - if lcase(Elem.name) = "subject" then - Elem.value = PostTitle - SetTitle = true - exit for - end if - Next + objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" + objHTTP.send data - if not SetTitle then - WScript.StdOut.WriteLine "failed to set post title" - WScript.Quit 1 - end if - - Dim SetMessage - SetMessage = False - Set NodeList = IE.document.getElementsByTagName("textarea") - For Each Elem In NodeList - WScript.StdOut.WriteLine Elem.name - if lcase(Elem.name) = "message" then - Elem.value = PostContent - SetMessage = true - exit for - end if - Next - - if not SetMessage then - WScript.StdOut.WriteLine "failed to set post message" - WScript.Quit 1 - end if + if objHTTP.Status <> 200 then + WScript.StdOut.WriteLine "Create beta file failed" + WScript.StdOut.WriteLine "status: " & objHTTP.Status + WScript.StdOut.WriteLine objHTTP.responseText + WScript.Quit 1 + end if + WScript.StdOut.WriteLine objHTTP.responseText + Set objHTTP = Nothing end sub -sub UploadDirectory(ieID, DirToUpload) +sub UploadFiles() + DirToUpload = WScript.Arguments(2) WScript.StdOut.WriteLine "UploadDirectory start - " & DirToUpload Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(DirToUpload) Set colFiles = objFolder.Files For Each objFile in colFiles - UploadFile ieID, DirToUpload & "\" & objFile.Name - Next + UploadFile DirToUpload & "\" & objFile.Name + Next WScript.StdOut.WriteLine "UploadDirectory Finished" end sub -sub UploadFile(ieID, FileToUpload) - set IE = FindIeWindow(ieID) +sub UploadFile(FileToUpload) + Const adTypeBinary = 1 + WScript.StdOut.WriteLine "UploadFile start - " & FileToUpload dim filePos @@ -389,72 +157,23 @@ sub UploadFile(ieID, FileToUpload) WScript.Quit 1 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 1 - end if - - 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 1 - 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 1 - 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 1 - 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 1 - end if - - Set InputList = FormList(0).getElementsByTagName("input") - WScript.StdOut.WriteLine "InputList.length = " & InputList.length - - 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 - 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 url + url = Project64Url() + "/index.php" dim fileContents fileContents = ReadBinaryFile(FileToUpload) - dim UploadUrl - UploadUrl = "http://forum.pj64-emu.com/" & FormList(0).action - IE2.Quit + dim PreFormData, PostFormData + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""option""" & vbCrLf & vbCrLf & "com_betafile"& vbCrLf + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""task""" & vbCrLf & vbCrLf & "AddFile"& vbCrLf + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""password""" & vbCrLf & vbCrLf & WScript.Arguments(1) & vbCrLf + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""jform[product_name]""" & vbCrLf & vbCrLf & WScript.Arguments(3) & vbCrLf + PreFormData = PreFormData & "--AaB03x" & vbCrLf & "Content-Disposition: form-data; name=""jform[add_file]""; 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 - Header = "Content-Type: multipart/form-data; boundary=AaB03x" & vbCrLf - - Const adTypeBinary = 1 - - Dim DataToPOSTStream + Dim DataToPOSTStream Set DataToPOSTStream = CreateObject("ADODB.Stream") DataToPOSTStream.type=adTypeBinary @@ -465,48 +184,47 @@ sub UploadFile(ieID, FileToUpload) DataToPOSTStream.Write = Stream_StringToBinary(PostFormData,"us-ascii") DataToPOSTStream.Position = 0 DataToPOSTStream.Type = adTypeBinary + Dim DataToPOST DataToPOST = DataToPOSTStream.Read - Set IE3 = CreateIeWindow() - IE3.Visible = 1 - dim ie3Id - ie3Id = IE3.HWND - WScript.StdOut.WriteLine "Uploading form to: " & UploadUrl - IE3.Navigate UploadUrl, Nothing, Nothing, DataToPOST, Header - WScript.Sleep 100 - 'set IE3 = FindIeWindow(ie3Id) - Wait IE3 - - Dim UploadDone - UploadDone = False - For count = 0 to 1000 - WScript.StdOut.WriteLine count & ": Waiting for upload done" - 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 - WScript.StdOut.WriteLine "Upload done" - exit for - end if - Next - if UploadDone then - exit for - end if - Next - - if not UploadDone then - WScript.StdOut.WriteLine "Failed to upload file" - WScript.Quit 1 - end if - IE3.Quit + Set objHTTP = CreateObject("Microsoft.XMLHTTP") + objHTTP.open "POST", url, False + objHTTP.setRequestHeader "Content-Type", "multipart/form-data; boundary=AaB03x" + objHTTP.setRequestHeader "Content-Length", Len(fileContents) + objHTTP.send DataToPOST + + if objHTTP.Status <> 200 then + WScript.StdOut.WriteLine "Failed to upload file" + WScript.StdOut.WriteLine "status: " & objHTTP.Status + WScript.StdOut.WriteLine objHTTP.responseText + WScript.Quit 1 + end if WScript.StdOut.WriteLine "UploadFile Finished" end sub +Function ReadBinaryFile(path) + Const adTypeBinary = 1 + Const adTypeText = 2 + + 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 + Function Stream_StringToBinary(Text, CharSet) - Const adTypeText = 2 Const adTypeBinary = 1 + Const adTypeText = 2 Dim BinaryStream Set BinaryStream = CreateObject("ADODB.Stream") @@ -523,21 +241,3 @@ Function Stream_StringToBinary(Text, CharSet) 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