option explicit 'settings const wikiExt = "wiki" const defaultDraftURL = "http://ru.wikipedia.org/wiki/%D0%92%D0%B8%D0%BA%D0%B8%D0%BF%D0%B5%D0%B4%D0%B8%D1%8F:%D0%9F%D0%B5%D1%81%D0%BE%D1%87%D0%BD%D0%B8%D1%86%D0%B0" 'ru 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) = "")-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 = "
" 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 & "" 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 & "" 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