'<nowiki>
option explicit
'settings
const wikiExt = "wiki"
const defaultDraftURL = "http://en.wikipedia.org/wiki/Wikipedia:Sandbox"
const workingDir = "" 'where .wiki files are saved; by default - script path
const backupSubDir = "backup\" 'where old .wiki files are moved if they are to be overwritten
const useIEpreview = true
'common objects
dim WShell: Set WShell = CreateObject("WScript.Shell")
dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
dim XML: Set XML = CreateObject("Microsoft.XMLHTTP")
dim objStream: Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2: objStream.CharSet = "UTF-8" '2 means adTypeText
dim path, articleURL, editURL, wpEdittime, wikiText, HTML 'some global vars
'set working folder (path variable)
if workingDir<>"" then
path = workingDir
if not FSO.FolderExists(path) then QuitWith "Please set correct 'workingDir'"
else
path = Left(WScript.ScriptFullName, InstrRev(WScript.ScriptFullName, "\"))
end if
'if no arguments - ask to assciate with .php
if WScript.Arguments.Count = 0 then
if msgbox("Associate .php files with this script?", vbYesNo, WScript.ScriptName) = vbYes then
dim ws: ws = WScript.Path & "\wscript.exe"
if not FSO.FileExists(ws) then QuitWith "Sorry, cannot find your file " & ws
ws = ws & " """ & WScript.ScriptFullName & """ ""%1"""
saveRegVal "HKCR\.php\shell\wikiedit\command\", ws
saveRegVal "HKCR\.php\shell\", "wikiedit"
msgbox "Done"
end if
WScript.Quit
end if
'check that argument is a valid file
dim arg: arg = WScript.Arguments(0)
if not FSO.FileExists(arg) then QuitWith "Input file not found: " & arg
'decide what to do
Select Case getFileExt(arg)
Case "php" processControlFile(arg)
Case wikiExt processWikiFile(arg)
Case else QuitWith "Input file extension not recognized"
End Select
Set objStream = Nothing
WScript.quit
'------------------------------------ Open .php Control File ------------------------------
function processControlFile(ctrlFile)
dim articleName, wikiFile
dim p1, p2, ch, fobj, controlText
'load Control File and get article URL
controlText = FSO.OpenTextFile(ctrlFile, 1).ReadAll
p1 = InStr(1, controlText, "URL=", vbTextCompare) + 4
p2 = InStr(p1, controlText, "&", vbTextCompare)
articleURL = Mid(controlText, p1, p2-p1)
'get article name, decode it and remove disallowed chars in order to create wiki file name
p1 = InStr(1, articleURL, "=", vbTextCompare) + 1
articleName = decodeURL(Mid(articleURL, p1))
for each ch in Array ("\", "/", ":", "*", "?")
articleName = replace (articleName, ch, "_")
next
wikiFile = path & articleName & "." & wikiExt
'backup old wiki file if it exists
if FSO.FileExists (wikiFile) and backupSubDir <>"" then
if not FSO.FolderExists(path & backupSubDir) then
on Error Resume Next
FSO.CreateFolder(path & backupSubDir)
if Err then QuitWith "Unable to create backup subfolder"
on Error Goto 0
end if
dim dd, backupName
dd = FSO.GetFile(wikiFile).DateLastModified
backupName = articleName &"."& year(dd)&"."&z(month(dd))&"."&z(day(dd))&"_"&z(hour(dd))&"."&z(minute(dd))&"."&z(second(dd))
on Error Resume Next
FSO.MoveFile wikiFile, path & backupSubDir & backupName & "." & wikiExt
if Err then QuitWith "Unable to backup existing ." & wikiExt & " file" & vbCrLf & "(" & Err.Description & ")"
on Error Goto 0
end if
'retreive article wiki code
XML.Open "GET", articleURL + "&action=raw", False
XML.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'to prevent caching
XML.Send
wikiText = XML.responseText
wpEdittime = CompactDate(XML.getResponseHeader("Last-Modified"))
'save wiki code into a file
'Set fobj = FSO.CreateTextFile(wikiFile, true, true) 'overwrite, unicode - creates non-UTF-8 file
'on Error Resume Next
objStream.Open
objStream.WriteText wikiText
objStream.SaveToFile wikiFile, 2 ' adSaveCreateOverWrite
'create info file
Set fobj = FSO.CreateTextFile(wikiFile & ".info", true, false) 'overwrite, ascii
fobj.WriteLine (articleURL)
fobj.WriteLine (wpEdittime)
fobj.Close
'start wiki file in editor
on Error Resume Next
WShell.Run wikiFile, 1, true
if Err then QuitWith "Created file '" & wikiFile & "'" & vbCrLf & vbCrLf & "Cannot start the file." & vbCrLf & "Please check that extension ." & wikiExt & " is associated with your text editor."
on Error Goto 0
end function
'------------------------------------ Open Wiki File ------------------------------
Function processWikiFile(wikiFile)
dim infoFile, htmlFile, fobj, isNewArticle
'read wiki file
objStream.Open
objStream.LoadFromFile wikiFile
wikiText = objStream.ReadText
objStream.Close
'get article URL
isNewArticle = true
infoFile = wikiFile & ".info"
if FSO.FileExists(infoFile) then 'from info file
set fobj = FSO.OpenTextFile(infoFile, 1) 'for reading
articleURL = fobj.ReadLine
wpEdittime = fobj.ReadLine
fobj.Close
isNewArticle = false
elseif left(wikiText,11) = "<!--http://" then 'from comment in article code
articleURL = mid(wikiText, 5, InStr(wikiText, "-->")-5)
articleURL = replace (trim(articleURL), " ", "_")
else 'new article with unknown url
articleURL = defaultDraftURL
end if
editURL = articleURL
if isNewArticle then
editURL = replace (editURL, "/wiki/","/w/index.php?title=")
wpEdittime = "20000101000000" 'if article in fact exists then make sure there's gonna be an edit conflict
end if
'create form HTML code
editURL = editURL & "&action=submit&wpPreview"
HTML = "<html><body><form method=post action='" & editURL & "' enctype='multipart/form-data'><input type=hidden name=wpEdittime value=" & wpEdittime & "><textarea name=wpTextbox1 style='display:none'>" & wikiText & "</textarea></form>"
if useIEpreview then
if not previewIE_TrySameWindow() then previewIE_NewWindow()
else
previewDefaultBrowser()
end if
'check article last-modified now
if not isNewArticle then
XML.Open "GET", articleURL & "&action=raw", False '!!! would use HEAD but it takes ages to get the answer...
XML.Send
if wpEdittime <> CompactDate(XML.getResponseHeader("Last-Modified")) then msgbox "Alert! Article has been changed on WikiMedia server"
end if
end function
'---------------------------------------------
function previewIE_TrySameWindow()
dim Boundary: Boundary = "--------p1415"
dim divPreview, PostData, Response
dim win, winurl, isFound, oldColor, oldBgColor
'find our IE window
isFound = false
for each win in CreateObject("shell.application").Windows
if typename(win.document) = "HTMLDocument" then
winurl = win.locationUrl
if InStr(winurl,"#") > 0 then winurl = left(winurl, InStr(winurl,"#") - 1) 'remove #
if winurl = editURL then 'found our window
set divPreview = win.document.all("wikiPreview")
if typename (divPreview) <> "Nothing" then isFound = true: exit for
end if
end if
next
if not isFound then previewIE_TrySameWindow = false: exit function
'kind of hide old preview
oldColor = divPreview.style.color: oldBgColor = divPreview.style.backgroundColor
divPreview.style.color = "#d0d0d0": divPreview.style.backgroundColor = "#d0d0d0"
'submit new preview
XML.Open "POST", editURL & "&live", False
XML.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
PostData = "--" & Boundary & vbCRLf _
& "Content-Disposition: form-data; name='wpTextbox1'" & vbCRLf & vbCRLf _
& wikiText & vbCRLf & "--" & Boundary
XML.Send Postdata
WShell.AppActivate win.document.title
Response = XML.responseText 'Response = mid(Response, InStr(Response, "<h2>"))
'decode XML to HTML
Response = replace (Response, ">", ">")
Response = replace (Response, "<", "<")
Response = replace (Response, """, """")
Response = replace (Response, "'", "'")
Response = replace (Response, "&", "&")
divPreview.innerHTML = Response
'restore colors
divPreview.style.color = oldColor
divPreview.style.backgroundColor = oldBgColor
'renew wiki text in a form
win.document.editform.wpTextbox1.value = wikiText
'done
previewIE_TrySameWindow = true
end function
'---------------------------------------------
function previewIE_NewWindow() ' submit preview in new IE window
dim IE: set IE = CreateObject("InternetExplorer.Application")
IE.navigate "about:blank"
do while IE.busy: loop
'write html and submit
IE.document.Open
IE.document.write HTML & "</html>"
IE.document.Close
IE.document.forms(0).submit()
IE.visible = 1
do while IE.busy: wscript.sleep 100: loop
WShell.AppActivate IE.document.title
'hide the edit form
if typename(IE.document.editform) = "Nothing" then exit function
IE.document.editform.style.display = "none"
'slightly move toolbar to hide it as well
dim obj: set obj = IE.document.getElementById("toolbar")
if typename(obj) <> "Nothing" then
IE.document.editform.insertBefore obj, IE.document.editform.firstChild
end if
' obj.style.display = "none"
'add a link to restore
IE.document.editform.parentNode.appendChild(IE.document.createElement("hr"))
set obj = IE.document.CreateElement("a")
obj.InnerHTML = "\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/"
obj.href = "javascript:document.editform.style.display='block';alert('If you edit text here, do not forget to close your editor');void 0"
IE.document.editform.parentNode.appendChild(obj)
end function
sub previewDefaultBrowser ()'save and launch submit file
objStream.Open
objStream.WriteText HTML & "<script>document.forms[0].submit()</script></body></html>"
objStream.SaveToFile path + "temp.htm" , 2 ' adSaveCreateNotExist
WShell.Run path + "temp.htm"
objStream.Close
end sub
'=========================== Misc Functions ===========================
Sub QuitWith (msg)
WShell.Popup msg, 0, WScript.ScriptName & ": Error", 48
WScript.Quit
End sub
Function getFileExt (fname) 'returns file extension
dim pos: pos = InStrRev(fname, ".")
getFileExt = ""
if pos > 0 then getFileExt = right(fname, len(fname) - pos)
end function
sub saveRegVal (regName, regVal)
on Error Resume Next
WShell.RegWrite regName, regval
if Err or (regval <> WShell.RegRead(regName)) then QuitWith "Unable to edit registry"
on Error Goto 0
end sub
function CompactDate (aDate) ' Sun, 04 Feb 2007 21:25:18 GMT => 20070204212518
dim arr, mm
arr = Split(aDate)
if UBound(arr)<>5 then QuitWith "Last-Modified not recognized"
mm = InStr("JanFebMarAprMayJunJulAugSepOctNovDec", arr(2))
if mm<=0 then QuitWith "Last-Modified not recognized (month)"
mm = Cstr((mm-1)/3 + 1): if len(mm)<2 then mm = "0" & mm
CompactDate = arr(3) & mm & arr(1) & replace(arr(4),":","")
end function
Function decodeURL(str) 'decode %D0%A3%... (1 or 2-byte UTF-8)
dim result, ii, byte1, byte2: result = "": ii=1
do while ii <= len(str)
if mid(str, ii, 1) = "%" then
byte1 = hex2dec(mid(str,ii,3))
byte2 = hex2dec(mid(str,ii+3,3))
if byte1 = null then
result = result & "%" 'starts with % but cannot decode....weird...just skip
ii = ii + 1
elseif byte1 < 128 then 'one-byte UTF
result = result & chrW(byte1)
ii = ii + 3
elseif byte2=null then 'cannot decode 2nd byte...just skip
result = result & mid(str,ii,4)
ii = ii + 4
else 'two-byte UTF
result = result & chrW( (byte1 and &H1F) * 64 or (byte2 and &H3F) )
ii = ii + 6
end if
else 'normal ascii char
result = result & mid(str,ii,1)
ii = ii + 1
end if
loop
decodeURL = result
end function
function hex2dec(hh) ' %D0 -> 208
dim jj, digit, result: result = 0
hex2dec = null
if len(hh)<>3 or left(hh,1)<>"%" then exit function
for jj = 2 to 3
digit = instr("0123456789ABCDEF", ucase(mid(hh, jj, 1))) - 1
if digit < 0 then exit function
result = result * 16 + digit
next
hex2dec = result
end function
function z(n) ' 7 -> 07
if len(CStr(n)) > 1 then z = CStr(n) else z = "0" & CStr(n)
end function
'</nowiki>
