User:Alex Smotrov/ExtEdit.vbs.css

'<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, "&lt;h2&gt;"))
'decode XML to HTML
Response = replace (Response, "&gt;", ">")
Response = replace (Response, "&lt;", "<")
Response = replace (Response, "&quot;", """")
Response = replace (Response, "&apos;", "'")
Response = replace (Response, "&amp;", "&")
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>