User:Smallbot/source/bible upload.vbs

From Wikimedia Commons, the free media repository
Jump to: navigation, 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]

  1. Open a plain text editor, such as notepad
  2. Copy and paste the code below into notepad
  3. Add your username, password
  4. Add the biblefolder, this is where the other folders are (Book of Genesis, Epistle of James, etc.).
  5. 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.
  6. 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".
  7. 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".
  8. Set the upload limit. Initially, set it to 10. If that works, set it to 1000.
  9. In notepad, select File->Save as and select "All files" at "File Save as Type"
  10. Enter the title bible.vbs and select save in a directory.
  11. 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.
  12. 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