User:Smallbot/source/bible upload.vbs
Jump to navigation
Jump to search
This is source for the script for fulfilling Commons:Bots/Requests/OrophinBot 2. It is written by User:Smallman12q.
The folders should be named as Book of Genesis, Epistle of James,...etc (according to Category:Books of the New Testament and Category:Books of the Old Testament, and presumable the same naming convention hold for English Wikipedia articles). The files as "1_Ge_01_02_RG.jpg". There should be no other folders in the biblefolder other than Genesis, Exodus, etc.
About the source: It's written in VBScript (~350 lines) and uses XHR and ADOB.Stream for uploading and reading as the API does not support base64 encoding. There is a log, and the script does provide some output as to the progress. It ignores image warnings (and doesn't log image upload failures...but that hasn't happened to me) The script uses binary multipart posts on XHR to upload images. Its written in VBScript because I couldn't find another bot written in VBScript=P (there are better ways to do this). It should work on a clean XP (or later) install.
Instructions[edit]
- Open a plain text editor, such as notepad
- Copy and paste the code below into notepad
- Add your username, password
- Add the biblefolder, this is where the other folders are (Book of Genesis, Epistle of James, etc.).
- Add the logfile, this is where the output will be logged. The logfile will be automatically created if it doesn't exist, or appended if it does.
- Set the lastfolder. If you have done a previous upload, this is the lastfolder, it can be obtained from the log. If not, set to "0".
- Set the lastfile. If you have done a previous upload, this is the last file name with extension, it can be obtained from the log. If not, set to "0".
- Set the upload limit. Initially, set it to 10. If that works, set it to 1000.
- In notepad, select File->Save as and select "All files" at "File Save as Type"
- Enter the title bible.vbs and select save in a directory.
- Right click on bible.vbs in the directory and select "Open with command prompt". It should run. You should get a command prompt window (a black window) with output.
- After a batch (the initial upload limit) is complete, modify the lastfolder and lastfile, and increase the upload limit if needed.
You may terminate the program by closing the window "X", hitting Crtl and C at the same time, or ending the "Wscript.exe" process in the task manager.
Smallman12q (talk) 23:45, 18 March 2012 (UTC)
Source[edit]
Option Explicit
Dim user: user="" 'Username
Dim pass: pass="" 'Password
Dim biblefolder: biblefolder = ""' The folder where the other folders are
Dim logfile: logfile="" 'Log file location
Dim lastfolder: lastfolder = "0"
Dim lastfile: lastfile = "0"
Dim limitupload: limitupload = 10
'On Error GoTo QuitError
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'force CScript execution
'http://stackoverflow.com/questions/4692542/force-a-vbs-to-run-using-cscript-instead-of-wscript
Sub forceCScriptExecution
Dim Arg, Str
If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
For Each Arg In WScript.Arguments
If InStr( Arg, " " ) Then Arg = """" & Arg & """"
Str = Str & " " & Arg
Next
CreateObject( "WScript.Shell" ).Run "cscript //nologo """ & WScript.ScriptFullName & """" & Str
WScript.Quit
End If
End Sub
forceCScriptExecution
''''''''''
'''''''''''''''''
Dim http: Set http = CreateObject("Microsoft.XMLHTTP")'"Mŝml2.XMLHTTP.3.0");
'Log file
Dim fs: Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(logfile) = false Then
Set objFile = fs.CreateTextFile(logfile)
End If
Const ForAppending = 8 ' ForAppending = 8 ForReading = 1, ForWriting = 2
Dim objTextFile: Set objTextFile = fs.OpenTextFile(logfile, ForAppending, True)
'objTextFile.Close 'We don't close
''''Login
Dim x 'node
Dim uploadcounter: uploadcounter = 0'uploadcounter
Report("-----" & Date & "------")
Report("Logging in as :" & user)
Report("Logging in... 1/2")
'initial post
wikipost "format=xml&action=login&lgname=" & Escape(user) & "&lgpassword=" & Escape(pass),0
nodeset "//api/login/@result"
If x Is Nothing Then
'error
WScript.Echo "Couldn't find initial login token."
Quit
End If
If x.value <> "NeedToken" Then
'error
WScript.Echo "Couldn't get initial login token."
Quit
End If
'Repost with token
Report("Logging in... 2/2")
nodeset "//api/login/@token"
wikipost "format=xml&action=login&lgname=" & Escape(user) & "&lgpassword=" & Escape(pass) & "&lgtoken=" & x.value,0
nodeset "//api/login/@result"
If x Is Nothing Then
'error
WScript.Echo "Couldn't find login result."
Quit
End If
If x.value <> "Success" Then
'error
WScript.Echo "Login failed."
Quit
End If
Report("Successfully logged in")
'''Edit Token
Dim edittoken
'Get edittoken from main talkpage
Report("Retrieving edit token...")
wikipost "format=xml&action=query&prop=info&intoken=edit&titles=Talk:Main%20Page", 0
nodeset("//api/query/pages/page/@edittoken")
If x Is Nothing Then
'error
WScript.Echo "Couldn't find edittoken."
Quit
End If
If x.value = "+\" Then
'error
WScript.Echo "Invalid edittoken."
Quit
End If
edittoken = x.value
Report("Edit token retrieved: " & edittoken)
'Multipart variables
Dim boundary: boundary = "89lbpohjyr5ewco0ho" 'Should be more random
'''ADODB.Stream
Dim Stream : Set Stream = CreateObject("ADODB.Stream")
'Type
Const adTypeBinary = 1
Const adTypeText = 2
'State
Const adStateClosed = 0
Const adStateOpen = 1
'''''''''''''''''''''''''''''''Local folders and editing
Dim allowfolder: allowfolder = False
Dim allowfile: allowfile = False
If lastfolder = "0" Then
allowfolder = True
End If
If lastfile = "0" Then
allowfile = True
End If
'For each file in each folder
Dim WshShell: Set WshShell = WScript.CreateObject("WScript.Shell") 'for sendkeys in upload
Dim bible: Set bible = fs.GetFolder(biblefolder)
Dim verse, vn, book, bookn, chapter, sp1, sp2, sp3, chapterup, chapterlast, chaptern
For Each book In bible.SubFolders
Report("Checking Book: " & book.name)
If allowfolder = False Then
If book.name = lastfolder Then
allowfolder = True
Report("Setting " & book.Name & " as allowfolder")
End If
End If
If allowfolder = True Then
Report(book.name & " entered")
chapterup = 0
chapterlast = 0
bookn = Replace(book.name,"_"," ")
'Create category for book
Report("Creating Category: " & bookn & " (Bible Illustrations by Sweet Media)")
editpage "Category:" & bookn & " (Bible Illustrations by Sweet Media)", _
"{{en|1=Bible illustrations from http://www.dsmedia.org/resources/illustrations/sweet-publishing/}}" &_
"[[Category:" + bookn + "]] [[Category:Media contributed by the Sweet Publishing]]", _
"Creating category for [[Commons:Bible Illustrations]]"
'Go through each file for the book
For each verse In book.Files
Report("Checking Verse: " & verse.name)
If allowfile = False Then
If verse.name = lastfile Then
allowfile = True
Report("Setting Verse " & verse.name & " as allowfile")
End If
End If
If allowfile = True Then
Report(verse.name & " entered")
vn = Replace(verse.name,"_"," ")
If fs.GetExtensionName(vn) = "jpg" Then
sp1 = InStr(vn," ")'Find 1st space
sp2 = InStr(sp1 + 1,vn," ")'Find 2nd space
sp3 = InStr(sp2 + 1,vn," ")'Find 3rd space
chapter = FormatNumber(Mid(vn,sp2 + 1,2) + chapterup,0,0) 'Remove leading zero
If chapter = "" and chapterup = 0 then 'It's 0, move up 1, and all other chapters in book
chapterup = 1
chapter = 1
End If
If chapter > chapterlast Then
Report("Creating Category: Book of " & bookn & " Chapter " & chapter & " (Bible Illustrations by Sweet Media)")
editpage "Category:Book of " & bookn & " Chapter " & chapter & " (Bible Illustrations by Sweet Media)", _
"[[Category:Book of " & bookn & " (Bible Illustrations by Sweet Media)]]", _
"Creating category for biblical book illustrations [[Commons:Bots/Requests/OrophinBot 2]]"
End If
uploadcounter = uploadcounter + 1
If uploadcounter > limitupload Then
Report("Exceeding upload limit...Quitting")
Report("Last folder: " & book.name)
Report("Last file: " & verse.name)
Quit
Else
Report("Uploading " & verse.path)
multipartpost verse.path, _
Replace( "Book of " & bookn & " Chapter " & chapter & "-" & FormatNumber(Mid(vn,sp3 + 1,2),0,0) & " (Bible Illustrations by Sweet Media).jpg", " ", "_"), _
("{{subst:Bible Illustrations (Sweet Publishing)-information|book=" & bookn & "|chapter=" & chapter & "}}") , _
"Uploading [[Commons:Bible Illustrations]] by Sweet Media"
End If
End If
End If
Next
End If
Next
Quit
'Dim a1: a1 = editpage ("User:Smallbot/1","asdf","test")
'Dim a1: a1 = multipartpost("C:\Users\Me\Pictures\test.gif","testing2.gif","API upload test")
''''''''''''''''''''''''''''''''''''''''''''
Sub wikipost(payload, attempt)
http.open "POST","http://commons.wikimedia.org/w/api.php",False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.send (payload)
If (httpstatus() = false) Then
If attempt < 3 Then
wikipost payload, attempt + 1
Else
WScript.Echo "POST FAILED|" & payload
'Quit, HTTP errors
End If
End If
End Sub
'Returns false if not 200 response
Function httpstatus()
If http.status <> 200 Then
httpstatus = False
End If
httpstatus = True
End Function
Sub nodeset(node)
Set x= http.responseXML.selectSingleNode(node)
End Sub
Function editpage (page,text,summary)
wikipost "format=xml&action=edit&title=" & Encode(page) & "&text=" & Encode(text) & "&summary=" & Encode(summary) &"&bot=1"& "&token=" & Encode(edittoken), 0
nodeset "//api/edit/@result"
If x Is Nothing Then
'error
WScript.Echo "Edit page error."
Quit
End If
If x.value <> "Success" Then
'error
WScript.Echo "Edit page failure."
Quit
End If
editpage = 1
End Function
Function multipartpost(source, filename, desc, comment)
http.open "POST","http://commons.wikimedia.org/w/api.php",False
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
Dim uploaddata
Dim params: params = Array("action","format","filename","text","comment","ignorewarnings","token")
Dim values: values = Array("upload","xml",filename,desc,comment,"1",edittoken)
Dim count
For count=0 To 6
uploaddata = uploaddata & vbNewLine & "--" & boundary & vbNewLine &_
"Content-Disposition: form-data; name=" & chr(34) & params(count) & chr(34) & vbNewLine &_
"Content-Type: text/plain" & vbNewLine &_
vbNewLine & values(count)
Next
'application/octet-stream
'image/gif
http.Send ConcatByteArrays( _
ConcatByteArrays( _
StringToBinary(uploaddata & vbNewLine & "--" & boundary & vbNewLine &_
"Content-Disposition: form-data; name=" & chr(34) & "file" & chr(34) &"; filename=" & chr(34) & filename & chr(34) & vbNewLine &_
"Content-Type: application/octet-stream" & vbNewLine &_
"Content-Transfer-Encoding: binary" & vbNewLine &_
vbNewLine), _
readFile(source)), _
StringToBinary(vbNewLine &_
"--" & boundary & "--" & vbNewLine))
multipartpost = 1
End Function
'http://stackoverflow.com/questions/184574/how-to-append-binary-values-in-vbscript
Function ConcatByteArrays(bytearray1, bytearray2)
ClearStream
'Open stream and write 1st, 2nd byte array
Stream.Open
Stream.Type = adTypeBinary 'Binary
Stream.Write bytearray1
Stream.Write bytearray2
Stream.Position = 0 'Reset position to read from start
ConcatByteArrays = Stream.Read
'Stream.Close
End Function
Sub ClearStream
If Stream.State <> adStateClosed Then
Stream.Close
End If
End Sub
'http://www.motobit.com/tips/detpg_binasp/
Function StringToBinary(Text)
ClearStream
'Set as text stream
Stream.Type = adTypeText
Stream.CharSet = "us-ascii" 'can change to others
'Write text to stream
Stream.Open
Stream.WriteText Text
'Change stream to binary
Stream.Position = 0 'Set position to 0 first
Stream.Type = adTypeBinary
'Open the stream as binary
StringToBinary = Stream.Read
'Stream.Close
End Function
'Get file in bytes
Function readFile(file)
ClearStream
Stream.type = adTypeBinary
Stream.Open
Stream.LoadFromFile(file)
readFile = Stream.Read
end Function
'http://www.motobit.com/tips/detpg_sendfrmie/
'URL encode of a string data
'Doesn't fully work
Function Encode(Data)
Dim I, C, Out
For I = 1 To Len(Data)
C = Asc(Mid(Data, I, 1))
If C = 32 Then
Out = Out + "+"
ElseIf C < 48 Then
Out = Out + "%" + Hex(C)
Else
Out = Out + Mid(Data, I, 1)
End If
Next
Encode = Out
End Function
Sub Report(strText)
WScript.Echo strText
objTextFile.WriteLine(strText)
End Sub
'http://blogs.technet.com/b/heyscriptingguy/archive/2004/10/05/how-can-i-pause-a-script-and-then-resume-it-when-a-user-presses-a-key-on-the-keyboard.aspx
Sub Quit
'QuitError:
WScript.Echo "The script is complete."
Wscript.StdOut.Write "Press the ENTER key to continue. "
Dim input1
Do While Not WScript.StdIn.AtEndOfLine
input1 = WScript.StdIn.Read(1)
Loop
End Sub