project64/Source/Script/upload_beta.vbs

243 lines
8.2 KiB
Plaintext

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
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 sub
function Project64Url()
Project64Url = "https://www.pj64-emu.com"
End Function
sub CreateUploadTarget()
dim BuildUrl
BuildUrl = WScript.Arguments(2)
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
dim d
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 = objHTTP.responseXML
Set objLst = xmlDoc.getElementsByTagName("freeStyleBuild")
Dim ProductDescription
For each elem in objLst
set childNodes = elem.childNodes
for each node in childNodes
if lcase(node.nodeName)="changeset" then
for each item in node.childNodes
dim commitId, comment
commitId = ""
comment = ""
for each itemDetail in item.childNodes
if lcase(itemDetail.nodeName)="commitid" then
commitId = itemDetail.text
end if
if lcase(itemDetail.nodeName)="comment" then
comment = Replace(Replace(itemDetail.text, vbLf, " "), vbCr, " ")
end if
next
if (Len(comment) > 0 and Len(commitId) > 0) then
ProductDescription = ProductDescription & "[*]" & comment & " (commit: [URL=""https://github.com/project64/project64/commit/" & commitId & """]"& commitId & "[/URL])" & vbCrLf
end if
next
end if
next
Next
if (Len(ProductDescription) > 0) then
ProductDescription = "Changes:"&vbCrLf&"[LIST]" & vbCrLf & ProductDescription & "[/LIST]"
else
ProductDescription = "No code changes"
end if
Dim url
url = Project64Url() + "/index.php"
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) & " " & Hour(build_date) & ":" & Minute(build_date) & ":" & Second(build_date)
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.open "POST", url, False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send data
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
Set objHTTP = Nothing
end sub
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 DirToUpload & "\" & objFile.Name
Next
WScript.StdOut.WriteLine "UploadDirectory Finished"
end sub
sub UploadFile(FileToUpload)
Const adTypeBinary = 1
WScript.StdOut.WriteLine "UploadFile start - " & FileToUpload
dim filePos
filePos = InStrRev(FileToUpload, "\")
if filePos = 0 then
WScript.StdOut.WriteLine "failed to find directory seperator in " & FileToUpload
WScript.Quit 1
end if
dim fileName
fileName = Mid(FileToUpload, filePos + 1, len(FileToUpload))
WScript.StdOut.WriteLine "fileName: " & fileName
extPos = InStrRev(fileName, ".")
if extPos = 0 then
WScript.StdOut.WriteLine "failed to find file extension in " & fileName
WScript.Quit 1
end if
extension = Mid(fileName, extPos, len(fileName))
if lcase(extension) <> ".zip" And lcase(extension) <> ".exe" And lcase(extension) <> ".apk" then
WScript.StdOut.WriteLine "not a valid extension: " & fileName
WScript.Quit 1
end if
Dim url
url = Project64Url() + "/index.php"
dim fileContents
fileContents = ReadBinaryFile(FileToUpload)
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
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 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 adTypeBinary = 1
Const adTypeText = 2
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