'Illustrates uploading to a Wiki (http://test.wikipedia.org/wiki/Sandbox)

Option Explicit

Main

Sub Main
Dim strData, dtDate, strPosting, web, strCookie, dicFormData
Const MULTIPART_BOUNDARY = "9876543210----------0123456789"
Const UPLOAD_URL = "http://test.wikipedia.org/w/index.php?title=Sandbox&action=submit" 
Const EDIT_URL = "http://test.wikipedia.org/w/index.php?title=Sandbox&action=edit"

	strPosting = InputBox("Enter text to be posted", "Wiki Post", "Scripted test posting")
	If strPosting = "" Then Exit Sub
	
	'Get data from "input" elements available on the edit form
	strData = ""
	strData = GetData(EDIT_URL)
	Set dicFormData = FormElements(strData)
	Set dicFormData = FormElements(strData)
	'Get a single cookie if it exists (requires a separate HTTP request because I'm lazy)
	strCookie = ""
	strCookie = GetCookie(EDIT_URL)
	
	'Build the POST data one element at a time
	strData = ""
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	If Not dicFormData.Exists("wpEdittime") Then Exit Sub
	strData = strData & "Content-Disposition: form-data; name=""wpEdittime""" & vbCrLf & vbCrLf
	strData = strData & dicFormData("wpEdittime")
	strData = strData & vbCrLf
	
	dtDate = Now + (8/24) 'Now in GMT
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpStarttime""" & vbCrLf & vbCrLf
	strData = strData & Year(dtDate) 
	strData = strData & Right("00" & Month(dtDate), 2)
	strData = strData & Right("00" & Day(dtDate), 2)
	strData = strData & Right("00" & Hour(dtDate), 2)
	strData = strData & Right("00" & Minute(dtDate), 2)
	strData = strData & Right("00" & Second(dtDate), 2)
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpSection""" & vbCrLf & vbCrLf
	If dicFormData.Exists("wpSection") Then strData = strData & dicFormData("wpSection")
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpScrolltop""" & vbCrLf & vbCrLf
	If dicFormData.Exists("wpScrolltop") Then strData = strData & dicFormData("wpScrolltop")
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpSummary""" & vbCrLf & vbCrLf
	If dicFormData.Exists("wpSummary") Then strData = strData & dicFormData("wpSummary")
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpEditToken""" & vbCrLf & vbCrLf
	If dicFormData.Exists("wpEditToken") Then strData = strData & dicFormData("wpEditToken")
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpSave""" & vbCrLf & vbCrLf
	If dicFormData.Exists("wpSave") Then strData = strData & dicFormData("wpSave")
	strData = strData & vbCrLf
	
	strData = strData & "--" & MULTIPART_BOUNDARY & vbCrLf
	strData = strData & "Content-Disposition: form-data; name=""wpTextbox1""" & vbCrLf & vbCrLf
	strData = strData & strPosting
	strData = strData & vbCrLf

	strData = strData & "--" & MULTIPART_BOUNDARY & "--"
	
	'Create the web (WinHttp) object
	On Error Resume Next
	Set web = Nothing
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	On Error Goto 0

	'Send the upload request to the Wiki server
	web.Open "POST", UPLOAD_URL, False
	web.SetRequestHeader "Referer", EDIT_URL
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & MULTIPART_BOUNDARY
	If strCookie <> "" Then web.setRequestHeader "Cookie", strCookie
	web.SetRequestHeader "Content-Length", Len(strData) + 2
	web.Send strData

End Sub

Function GetCookie(strUrl)
'Gets the first cookie that a server tries to set
	Dim web, strCookie
	On Error Resume Next
	Set web = Nothing
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	web.Open "GET", strUrl, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	strCookie = web.getResponseHeader("Set-Cookie")
	strCookie = Split(strCookie, ";")(0)
	GetCookie = strCookie
End Function

Function FormElements(strHtmText)
'Returns a dictionary of form "input" elements and their default values
'For example, with HTML text containing this:
'<input type='hidden' value="" name="wpSection" />
'A declaration might be like this:
'Set dicForm = FormElements(strHtmText)
'With data testing like this: 
'If dicForm.Exists("wpSection") Then MsgBox dicForm("wpSection")
Dim arrInputs, strInputs, strInput, intCount, strName, strValue, dic
	Set dic = CreateObject("Scripting.Dictionary")
	strInputs = strHtmText
	strInputs= Replace(strInputs, "<input", "§", 1, -1, vbTextCompare)
	arrInputs = Split(strInputs, "§")
	For Each strInput In arrInputs
		strInput = Left(strInput, InStr(strInput, ">"))
		strName = ""
		If InStr(1, strInput, " name=", vbTextCompare) <> 0 Then
			strName = Mid(strInput, InStr(1, strInput, " name=", vbTextCompare))
			strName = Mid(strName, InStr(strName, "=") + 1)
			Select Case Left(strName, 1)
				Case """"
					strName = Split(strName, """")(1)
				Case "'"
					strName = Split(strName, "'")(1)
				Case Else
					strName = Split(strName, " ")(0)
			End Select
		End If
		strValue = ""
		If InStr(1, strInput, " value=", vbTextCompare) <> 0 Then
			strValue = Mid(strInput, InStr(1, strInput, " value=", vbTextCompare))
			strValue = Mid(strValue, InStr(strValue, "=") + 1)
			Select Case Left(strValue, 1)
				Case """"
					strValue = Split(strValue, """")(1)
				Case "'"
					strValue = Split(strValue, "'")(1)
				Case Else
					strValue = Split(strValue, " ")(0)
			End Select
		End If
		If strName <> "" Then
			dic.Add strName, strValue
		End If
	Next
	Set FormElements = dic
	Set dic = Nothing
End Function

Function GetData(strUrl)
'Returns the HTML source of a web page
Dim web
Const WinHttpRequestOption_EnableRedirects = 6
	Set web = Nothing
	On Error Resume Next
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	If web Is Nothing Then
		GetData = ""
		Exit Function
	End If
	web.Option(WinHttpRequestOption_EnableRedirects) = True
	web.Open "GET", strURL, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	If web.Status = "200" Then
		GetData = web.ResponseText
	Else
		GetData = ""
	End If
End Function