User:Smallbot/source/Beaverton Oregon Historical Gallery
The following is the source code used for Commons:Bots/Requests/Smallbot 4.
You need XP , IE6 (for mshtml), and .net 2 (for fiddler).
The download is done in vbscript w/ xhr for the http requests, mshtml for the html parsing, ADOB.stream for the reading/writing, Msxml2.DOMDocument for the xml. Images are encoded as base64 (which inflates their size ~33%) so they can be stored as plain text in the xml file.
XHR-> Microsoft.XMLHTTP (MSXML2.XMLHTTP.3.0)
VBScript, while old, is easy to use for COM scripting without requiring casting. MSHTML is used as it will parse tag soup (and often, that mess is meant for IE and will choke other parsers). Also, due to its age, VBScript works on virtually all windows machines. VB6 is no longer supported.
PowerShell 3 has Invoke-WebRequest which is promising. Alternatively, Qt has QtWebKit, but requires more code than VBScript.
Source
editThe source code is released under the MIT license
|
This file is licensed under the Expat License, sometimes known as the MIT License:
Copyright © 2012 Smallman12q Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. The Software is provided "as is", without warranty of any kind, express or implied, including but not limited to the warranties of merchantability, fitness for a particular purpose and noninfringement. In no event shall the authors or copyright holders be liable for any claim, damages or other liability, whether in an action of contract, tort or otherwise, arising from, out of or in connection with the Software or the use or other dealings in the Software.
|
Download
editFollowing the download, a root xml tag is added with Quick Editor 4 (Quick Editor 3.5).
Const btonxml = "C:\Beaverton.xml" 'XML file where data is stored
Const btoncsv = "C:\bton.csv" 'ID stored
Dim html: Set html = CreateObject("htmlfile") 'MSHTML.HTMLDocument
Dim http: Set http = CreateObject("Microsoft.XMLHTTP") 'MSXML2.XMLHTTP.3.0
Dim xmldoc: Set xmldoc = CreateObject("Msxml2.DOMDocument")
'Setup regex for catching years in title
Dim re: Set re = New regexp
re.Pattern = "\b1[89][0-9]{2}\b" 'http://utilitymill.com/utility/Regex_For_Range
'Write to file after every image
Const ForAppending = 8
Dim fs: Set fs = CreateObject("Scripting.FileSystemObject")
Dim file: Set file = fs.OpenTextFile(btonxml, ForAppending, True,0) '0=ANSI, -1=Unicode
Const ForReading = 1
Dim fcsv: Set fcsv = fs.OpenTextFile(btoncsv, ForReading, True,0)
Dim csvdata: csvdata = "" 'sort of csv ... data is ",#,,#,,#,"
Do While Not fcsv.AtEndOfStream
csvdata = csvdata fcsv.ReadAll
Loop
WScript.Echo csvdata
fcsv.Close
Set fcsv = fs.OpenTextFile(btoncsv, ForAppending, True,0)
'12 Categories
Dim cats: cats = Array("Aerial", "Airport", "Buildings", "Businesses", "Churches", "Events", "Lumbermill", "Other", "People", "Schools", "Streets", "Transportation")
Dim catcounter, catname
'For Each cat In cats
For catcounter = 0 To 13 'Change here to number of cats
Set html = Nothing
Set html = CreateObject("htmlfile") 'New instance
catname = cats(catcounter)
WScript.StdOut.WriteLine "CAT: " & catname & "(" & catcounter & ")"
'Dim county: Set county = xmldoc.createElement("county")
'xmldoc.appendChild(county)
file.WriteLine("<cat id=""" & catname & """>")
'''''''''
'Get number of images from cat
http.open "GET", "http://apps.beavertonoregon.gov/HistoricPhotos/category_results.aspx?cat=" & catname , False
http.send
html.write(http.responseText)
Dim numberofimages : numberofimages= html.getElementsByTagName("span")(2).innerHTML
Dim imagesread: imagesread = 1
'Read cat data
Dim ispancounter : ispancounter= 3
For imagesread = 1 To numberofimages
WScript.StdOut.WriteLine "Reading: " & imagesread & "/" & numberofimages
'MsgBox "1"
If ispancounter > 22 Then 'Reset at end and load next page
'MsgBox "here1"
ispancounter= 3
'html.forms.
'Dim viewstate : viewstate = html.getElementsByTagName("span")(0).
Dim viewstate : viewstate = html.getElementsByTagName("input")(0).value'html.forms("ctl00").__VIEWSTATE.Value
Dim eventvalidation : eventvalidation = html.getElementsByTagName("input")(2).value 'html.forms("ctl00").__EVENTVALIDATION.Value
Dim sRequest : sRequest= "__VIEWSTATE=" & EncodeURI(viewstate) &_
"&__VIEWSTATEENCRYPTED=&__EVENTVALIDATION=" & EncodeURI(eventvalidation) &_
"&btnNext=Next»"
'html.clear
html.open "about:blank"
'html.updateSettings()
http.open "POST", "http://apps.beavertonoregon.gov/HistoricPhotos/category_results.aspx?cat=" & catname , False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.setRequestHeader "Content-Length", Len(sRequest)
http.send sRequest
html.write (http.responseText)
End If
Dim imagename : imagename = html.getElementsByTagName("span")(ispancounter).innerHTML
'MsgBox "2"
Dim tempid
Dim picyear
If Left(imagename,6) = " " Then
tempid = Split(Split(imagename,"?id=")(1),Chr(34))(0)'"
'tempid = tempid(1),"'")
imagename = "Unknown"
Else
tempid = Split(imagename," - ")(0)
imagename = Split(imagename," - ")(1)
End If
'Ids may be duplicate, check when uploading
'Extract year from imagename
Set picyear = re.Execute(imagename)
If picyear.Count = 1 Then
picyear = picyear.Item(0).Value
Else
picyear = ""
End If
Dim source: source = Replace(html.getElementsByTagName("img")(ispancounter - 1).src,"_t.jpg","_p.jpg")
'about:
'1234567
source = "http://apps.beavertonoregon.gov/HistoricPhotos/" & Mid(source,7)
Dim stempid: stempid = "," tempid ","
Dim b64
If(InStr(1,csvdata,stempid) <= 0) Then
http.open "GET", source, False
http.send
Set b64 = xmldoc.createElement("imagedata")
With b64
.dataType = "bin.base64"
.nodeTypedValue = http.responseBody
End With
csvdata = csvdata stempid
fcsv.Write(stempid)
Else
Set b64 = xmldoc.createElement("imagedata")
End If
'http.close
'''''''''''''
'Write out nodes
Dim image: Set image = xmldoc.createElement("image")
xmldoc.appendChild(image)
caddelement "title", imagename
caddelement "id", tempid
caddelement "year", picyear
caddelement "src", source
image.appendChild(b64)
file.WriteLine PrettyPrintXml (xmldoc)
xmldoc.removeChild(image)
WScript.StdOut.WriteLine "Written."
WScript.Sleep 5000
'MsgBox source
'MsgBox numberofimages
'MsgBox imagename & "|" & tempid
ispancounter = ispancounter 1
Next
file.WriteLine("</cat>")
Next
WScript.StdOut.WriteLine "Done."
WScript.StdIn.ReadLine
Function EncodeURI(data)
'http://stackoverflow.com/questions/9628080/get-value-from-a-javascript-function-in-vbscript
'http://stackoverflow.com/questions/332872/how-to-encode-a-url-in-javascript
'use with caution
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q266343
Dim d: Set d = html.parentWindow
d.execScript("var UrlEscape = function(){return encodeURIComponent('"& data & "');}")
EncodeURI = d.UrlEscape()
End Function
Sub caddelement(elementname, elementvalue) 'image add element
Dim element: Set element = xmldoc.createElement(elementname)
element.text = elementvalue
'Dim value : Set value = xmldoc.createTextNode(elementvalue)
'element.appendChild(value) 'Set the element value
image.appendChild(element) 'Add element to county
End Sub
'http://stackoverflow.com/questions/4328907/add-child-entry-to-a-specific-node-in-xml-file-in-vbscipt
Function PrettyPrintXml(xmldoc)
Dim reader
set reader = CreateObject("Msxml2.SAXXMLReader.6.0")
Dim writer
set writer = CreateObject("Msxml2.MXXMLWriter.6.0")
writer.indent = True
writer.omitXMLDeclaration = True
reader.contentHandler = writer
reader.putProperty "http://xml.org/sax/properties/lexical-handler", writer
reader.parse(xmldoc)
PrettyPrintXml = writer.output
End Function
Image source order
editAlso see User:Smallbot/source/Oregon Historical County Records Guide#Tag Name number and User:Smallbot/source/Oregon Historical County Records Guide#Link number.
var w = window.open('', '', 'width=1000,height=500,resizable,scrollbars');
w.document.open();
w.document.write("<html><head><title>Viewing image...</title></head>");
w.document.write("<body onload = 'self.focus()'>");
var element = "IMG"
var elements = document.getElementsByTagName(element);
if(elements.length > 0)
{
w.document.write("<h5>" element "</h5>");
//start table
w.document.write("<table border=\"1\" title=\"" element "\">");
w.document.write("<tr>");
w.document.write("<th>#</th>");
w.document.write("<th>src</th>");
w.document.write("<tr>");
//write rows
for (var elementscounter = 0; elementscounter < elements.length; elementscounter =1)
{
w.document.write("<tr>");
w.document.write("<td name=\"" elementscounter "\">" elementscounter "</td>");
w.document.write("<td><pre><code>" elements[elementscounter].src "</code></pre></td>");
w.document.write("</tr>");
}
//close table
w.document.write("</table>");
w.document.write("<br/>");
}
w.document.write("</body></html>");
w.document.close();
Upload
editThe source xml file can be found at dropbox (~210MB).
Const user = "user"
Const pass = "password"
Const btonxml = "C:\Beaverton.xml" 'XML file where data is stored
Const upcounterstart = 0 'start at end/ next upcounter
Const upcounterend = 400
''
Dim html: Set html = CreateObject("htmlfile") 'MSHTML.HTMLDocument
Dim http: Set http = CreateObject("Microsoft.XMLHTTP") 'MSXML2.XMLHTTP.3.0
Dim objXMLDoc: Set objXMLDoc = CreateObject("Msxml2.DOMDocument")'"Microsoft.XMLDOM")
Class Bimage
Public c, t, i, y, s, d
End Class
Dim Bimages(350)
'''''''''''''''
'Can also use https
Dim Console: Set Console = WScript.StdOut
''''Login
Dim x 'node
Console.WriteLine "Logging in as :" & user
Console.WriteLine "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
Console.WriteLine "Couldn't find initial login token."
Quit
End If
If x.value <> "NeedToken" Then
Console.WriteLine "Couldn't get initial login token."
Quit
End If
'Repost with token
Console.WriteLine "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
WScript.Echo "Couldn't find login result."
Quit
End If
If x.value <> "Success" Then
Console.WriteLine "Login failed."
Quit
End If
Console.WriteLine "Successfully logged in"
'''Edit Token
Dim edittoken
'Get edittoken from main talkpage
Console.WriteLine "Retrieving edit token..."
wikipost "format=xml&action=query&prop=info&intoken=edit&titles=Talk:Main Page", 0
nodeset("//api/query/pages/page/@edittoken")
If x Is Nothing Then
Console.WriteLine "Couldn't find edittoken."
Quit
End If
If x.value = " \" Then
Console.WriteLine "Invalid edittoken."
Quit
End If
edittoken = x.value
Console.WriteLine("Edit token retrieved: " & edittoken)
'Multipart variables
Dim boundary: boundary = "8G9lbpohjyr5ewclo0ho" '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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
objXMLDoc.async = False
objXMLDoc.validateOnParse = True
objXMLDoc.load(btonxml)'b.xml")
'MsgBox "loaded"
Dim root: Set root = objXMLDoc.documentElement
'MsgBox root.xml
Dim cats: Set cats = root.getElementsByTagName("cat")
Dim cat
For Each cat In cats
Dim catname: catname = cat.Attributes.item(0).text
Dim images: Set images = cat.childNodes'getElementsByTagName("image")
Dim image
For Each image In images
Dim imagen : Set imagen = image.childNodes
'Dim title: Set title = image.getElementsByTagName("title")(0)
Dim ititle: ititle = imagen.nextNode.text
Dim iid: iid = imagen.nextNode.text
Dim iyear: iyear = imagen.nextNode.text
Dim isrc: isrc = imagen.nextNode.text
Dim idata: idata = imagen.nextNode.nodeTypedValue
If TypeName(idata) = "Byte()" Then 'Not set yet
Set Bimages(iid) = New Bimage
Bimages(iid).c = catname
Bimages(iid).t = ititle
Bimages(iid).y = iyear
Bimages(iid).s = isrc
Bimages(iid).d = idata
'MsgBox iid
Else 'Already set
Bimages(iid).c = Bimages(iid).c & "," & catname
End If
'MsgBox ititle & "|" & iid & "|" & iyear & "|" & CStr(idata)
Next
Next
Dim upcounter: upcounter = 0
Dim i
For i = 0 to UBound(Bimages)
If IsObject(Bimages(i)) Then
'WScript.StdOut.WriteLine Bimages(i).t & "|" & Bimages(i).c & "|" & i
'Exist so upload
If upcounter => upcounterstart Then 'Maybe Upload
If upcounter < upcounterend Then 'Upload
WScript.StdOut.WriteLine "-------------------------------------------------"
WScript.StdOut.WriteLine upcounter & "|" & Bimages(i).t & "|" & i
Dim categories : categories = Split(Bimages(i).c,",")
Dim categoriestext : categoriestext = ""
Dim category
For Each category In categories
categoriestext = categoriestext vbNewLine & "[[Category:" & category & " images of Beaverton, Oregon]]"
Next
'Generate template category
Dim template: template = "{{Information " & vbNewLine &_
"|Description= {{en|1=" & Bimages(i).t & ". Historical images of {{w|Beaverton, Oregon}}.}}" & vbNewLine &_
"|Date= " & Bimages(i).y & vbNewLine &_
"|Source= {{en|1=[http://apps.beavertonoregon.gov/HistoricPhotos/ Beaverton Oregon Historical Photo Gallery]:" &_
" [http://apps.beavertonoregon.gov/HistoricPhotos/category_results.aspx?cat=" & Bimages(i).c & " " & Bimages(i).c & " Gallery]" &_
" [" & Bimages(i).s & " Direct]}}" & vbNewLine &_
"|Author= {{unknown photographer}}" & vbNewLine &_
"|Permission= {{Beaverton Oregon Historical Photo Gallery}}" & vbNewLine &_
"|Other_fields= " & vbNewLine &_
"{{Information field|name=Photo No. |value= " & i & "}}" & vbNewLine &_
"}}" & vbNewLine &_
categoriestext
'WScript.StdOut.WriteLine(template)
'Upload file
multipartpost Bimages(i).d, _
Bimages(i).t & " (Beaverton, Oregon Historical Photo Gallery) (" & i & ").jpg", _
template, _
"[[Commons:Bots/Requests/Smallbot 4]]: Uploading images from Beaverton, Oregon Historical Photo Gallery"
'Assume success...else check response in fiddler2
upcounter = upcounter 1
Else 'Quit
WScript.StdOut.WriteLine "Upload batch portion finished."
WScript.StdIn.ReadLine
WScript.Quit
End If
Else ' Skip
upcounter = upcounter 1
End If
End If
Next
WScript.StdOut.WriteLine "Upload batch complete."
WScript.StdIn.ReadLine
WScript.Quit
''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''
Sub wikipost(payload, attempt)
http.open "POST","https://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
Console.WriteLine "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
Sub Quit
Console.WriteLine "Quit"
WScript.Quit
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
Console.WriteLine "Edit page error->nothing->" & page
Quit
End If
If x.value <> "Success" Then
'error
Console.WriteLine "Edit page failure." & page
Quit
End If
editpage = 1
End Function
Sub multipartpost(source, filename, desc, comment)
http.open "POST","https://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/jpg
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), _
source), _
StringToBinary(vbNewLine &_
"--" & boundary & "--" & vbNewLine))
End Sub
'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
Function Encode(data)
'http://stackoverflow.com/questions/9628080/get-value-from-a-javascript-function-in-vbscript
'http://stackoverflow.com/questions/332872/how-to-encode-a-url-in-javascript
'use with caution
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q266343
Dim d: Set d = html.parentWindow
d.execScript("var UrlEscape = function(){return escape('"& data & "');}")
EncodeURI = d.UrlEscape()
End Function
Create Categories
editConst user = "user"
Const pass = "pass"
''
Dim html: Set html = CreateObject("htmlfile") 'MSHTML.HTMLDocument
Dim http: Set http = CreateObject("Microsoft.XMLHTTP") 'MSXML2.XMLHTTP.3.0
Dim objXMLDoc: Set objXMLDoc = CreateObject("Msxml2.DOMDocument")'"Microsoft.XMLDOM")
'''''''''''''''
'Can also use https
Dim Console: Set Console = WScript.StdOut
''''Login
Dim x 'node
Console.WriteLine "Logging in as :" & user
Console.WriteLine "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
Console.WriteLine "Couldn't find initial login token."
Quit
End If
If x.value <> "NeedToken" Then
Console.WriteLine "Couldn't get initial login token."
Quit
End If
'Repost with token
Console.WriteLine "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
WScript.Echo "Couldn't find login result."
Quit
End If
If x.value <> "Success" Then
Console.WriteLine "Login failed."
Quit
End If
Console.WriteLine "Successfully logged in"
'''Edit Token
Dim edittoken
'Get edittoken from main talkpage
Console.WriteLine "Retrieving edit token..."
wikipost "format=xml&action=query&prop=info&intoken=edit&titles=Talk:Main Page", 0
nodeset("//api/query/pages/page/@edittoken")
If x Is Nothing Then
Console.WriteLine "Couldn't find edittoken."
Quit
End If
If x.value = " \" Then
Console.WriteLine "Invalid edittoken."
Quit
End If
edittoken = x.value
Console.WriteLine("Edit token retrieved: " & edittoken)
'Multipart variables
Dim boundary: boundary = "8G9lbpohjyr5ewclo0ho" '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
'12 Categories
Dim cats: cats = Array("Aerial", "Airport", "Buildings", "Businesses", "Churches", "Events", "Lumbermill", "Other", "People", "Schools", "Streets", "Transportation")
Dim cat
For Each cat In cats
Dim ptitle: ptitle = "Category:" & cat & " images of Beaverton, Oregon"
Console.WriteLine "Creating " & ptitle
editpage ptitle,"[[Category:Beaverton, Oregon Historical Photo Gallery]]","[[Commons:Bots/Requests/Smallbot 4]]: Uploading images from Beaverton, Oregon Historical Photo Gallery, creating categories."
Console.WriteLine "Created..."
Next
Console.WriteLine "Done."
'''''''''''''''''''''''''''''''''''
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
Console.WriteLine "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
Sub Quit
Console.WriteLine "Quit"
WScript.Quit
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
Console.WriteLine "Edit page error->nothing->" & page
Quit
End If
If x.value <> "Success" Then
'error
Console.WriteLine "Edit page failure." & page
Quit
End If
editpage = 1
End Function
Sub 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/jpg
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), _
source), _
StringToBinary(vbNewLine &_
"--" & boundary & "--" & vbNewLine))
End Sub
'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
'Very primitive escape
Function Encode(unencoded)
Encode= Replace(Escape(unencoded)," ","+")
End Function
Fiddler
editSee User:Smallbot/source/Oregon Historical County Records Guide#Fiddler.