'Kleines Script zum Erzeugen von Html-Output aus XML-Dokumenten
'Jürgen Auer, 04/08 2003
'Das Script lädt das im aktuellen Ordner befindliche www.sql-und-xml.de.xsl, 
'setzt den Parameterwert (Standard: .xml) auf .html, auf daß nicht die 
'Verweise von Html-Seiten plötzlich auf XMl-Dokumente zielen,
'lädt jedes Xml-Dokument im aktuellen Ordner, matcht es mit dem XSL und 
'speichert es unter ..\ mit geänderter Endung ab.
'Derzeit werden die Outputs als ANSI gespeichert, damit auch sehr alte Browser,
'die noch kein Unicode können, damit klarkommen.

'Hinweis: Dieses Script ist derzeit sehr experimentell
'Starten Sie es mit WScript, so erhalten Sie ständig MessageBoxen
'Deshalb: CScript transform-xml-to-html-output.vbs
'Dann werden gewisse Meldungen in der Konsole ausgegeben

'Wenn Sie das Script für eigene Zwecke verwenden möchten, ist folgendes zu beachten:
'1. Wenn Sie anstelle der MSXML4 die MSXML3 installiert haben, ändern Sie (1) ab
'	aus DOMDocument.4.0 wird DOMDocument.3.0
'
'2. Löschen Sie die Zeile (2) bzw. kommentieren Sie diese aus. Diese Zeile ist speziell für 
'	meine XSL-Datei, ich benötige sie, um bei Links die Dateiendungen auf Xml bzw. 
'	Html zu setzen
'
'3. Setzen Sie in (3) Ihre eigene Xsl-Datei ein, das Script kommt in denselben Unterordner, 
'	dieser darf nicht / sein.
'
'Das Script lädt einmalig die Xsl-Datei, sucht in seinem eigenen Ordner und allen tieferliegenden 
'	Ordnern nach Xml-Dateien, lädt diese, matcht sie mit dem Xsl-Dokument und speichert den
'	Html-Output unter ../ bzw. in analog dort erstellten Unterordnerstrukturen ab.
'	Gibt es bereits Dateien mit demselben Namen, werden diese ohne Nachfragen überschrieben




Function open_xmlDoc(xDoc, relative_Path, base_path)
'(1)
Set xDoc = WScript.CreateObject("MsXML2.DOMDocument.4.0")
xDoc.async = False
'xDoc.validateOnParse = True
xDoc.load base_path & relative_Path
End Function



Function transform_folder(fso, xslDoc, source_path, base_path, this_folder, cur_subFolder, create_print)

Dim f_list, folder_list, f, fo, xmlDoc, new_fileName, new_FileStream, str_transformResult, cur_resultFolder, bol_write_Unicode

Set f_list = this_folder.Files

'Falls die Datei xml-lernen.xml bearbeitet wird, wird diese als Unicode gespeichert - alten Browsern zum Trotz
'Denn gerade die Unicode-Elemente sind das, was über Html hinausgeht

cur_resultFolder = base_path & cur_subFolder
cur_resultFolder = Left(cur_resultFolder, Len(cur_resultFolder) - 1)

'WScript.Echo "cur_ResultFolder: " & cur_resultFolder

If Not fso.FolderExists(cur_resultFolder) Then
	fso.CreateFolder(cur_resultFolder)
End If

For Each f In f_list
	bol_create_document = False
	new_fileName = ""

	If Right(f.Name, 4) = ".xml" Then
		open_xmlDoc xmlDoc, f.Name, source_path
		'MsgBox xmlDoc.TransformNode(xslDoc)
		If create_print Then
			If (Len(cur_subFolder) > 0) And (f.name = "index.xml") Then
				new_fileName = fso.GetAbsolutePathName(base_path & cur_subFolder & Left(cur_subFolder, Len(cur_subFolder) - 1) & "-print.html")
				
			End If
		Else
			new_fileName = fso.GetAbsolutePathName(base_path & cur_subFolder & Left(f.Name, Len(f.Name) - 3) & "html")
		End If

		'WScript.Echo "source_Path: " & source_Path
		'WScript.Echo "Aktuell : " & f.name 
		'WScript.Echo "Neu	: " & new_fileName

		'WScript.Echo new_FileName

		On Error Resume Next
		If Len(new_FileName) > 0 Then
			If fso.FileExists(new_FileName) Then fso.DeleteFile new_FileName, True
			If Err.Number <> 0 Then
				WScript.Echo "Datei " & new_FileName & " konnte nicht gelöscht werden"
			Else
				bol_create_document = True
			End If
		End If
		
		On Error Goto 0

		bol_write_Unicode = 0


		'WScript.Echo cur_resultFolder

		If (InStr(1, cur_resultFolder, "\xml-lernen") > 0) Then 
			'bol_write_Unicode = -1
		End If

		'bol_write_Unicode = True
		'WScript.Echo bol_write_Unicode

		If Not (xmlDoc.SelectSingleNode("//@create-html") Is Nothing) Then
			If xmlDoc.SelectSingleNode("//@create-html").Value = "no" Then
				bol_create_document = False
			End If
		End If

		If bol_create_document Then
			Set new_FileStream = fso.CreateTextFile(new_FileName, True, bol_write_Unicode)
			str_transformResult = xmlDoc.TransformNode(xslDoc)
			
			WScript.Echo new_FileName
			If Len(xmlDoc.parseError.srcText) > 0 Then
				WScript.Echo xmlDoc.parseError.srcText
				WScript.Echo xmlDoc.parseError.reason
			End If

			'WScript.Echo "Resultat von " & new_FileName & ": " & str_transformResult

			'Die folgende Zeile entfernt den lästigen, von der Transformation eingefügten
			'Meta-Ausdruck, der mit dem selbstdefinierten Content-Type kollidiert
	
			str_transformResult = Replace(str_transformResult, _
				"<META http-equiv=""Content-Type"" content=""text/html"">", "")
			str_transformResult = Replace(str_transformResult, _
				"<html xmlns:html=""http://www.w3.org/1999/xhtml"">", _
				"<html xmlns='http://www.w3.org/1999/xhtml'>")
	
			On Error Resume Next		 
			new_FileStream.Write str_transformResult
			If err.Number <> 0 Then
				WScript.Echo str_transformResult
				WScript.Echo err.Description
			End If
			On Error Goto 0
			new_FileStream.Close

		End If
		


	End If
Next

For Each fo In this_folder.SubFolders
	'WScript.Echo "Subfolder: " & fo.Name

	transform_folder fso, xslDoc, source_path & fo.Name & "\", base_path & cur_subFolder, fo, fo.Name & "\", create_print

Next


End Function



Dim xslDoc, fso, script_Path, base_path, i, this_folder, f, new_fileName, new_FileStream, str_transformResult, bol_write_Unicode, bol_create_document, bol_create_print, css_file

script_Path = Replace(WScript.ScriptFullname, WScript.ScriptName, "")
bol_create_print = False
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

'(3)
open_xmlDoc xslDoc, "www.sql-und-xml.de.xsl", script_Path

'(2) Verknüpfungsendungen auf html ändern, falls nicht 'print' - Output produziert wird

if WScript.Arguments.Length > 0 Then
	If WScript.Arguments(0) = "print" Then
		xslDoc.SelectSingleNode("//*[@name = 'output-filetype']").Text = "print"
		bol_create_print = True
		xslDoc.SelectSingleNode("//*[@name = 'css-file']").Text = fso.OpenTextFile("../sql-datenbank-mieten.css").ReadAll()
	Else
		xslDoc.SelectSingleNode("//*[@name = 'output-filetype']").Text = "html"
	End If
Else
	xslDoc.SelectSingleNode("//*[@name = 'output-filetype']").Text = "html"
End If

Set this_folder = fso.GetFolder(Left(script_Path, Len(script_Path) - 1))



base_path = fso.GetAbsolutePathName(script_Path & "..\")


transform_folder fso, xslDoc, script_path, base_path, this_folder, "\", bol_create_print