'*** v9.5 *** www.dieseyer.de ******************************
'
' Datei:  wim_inhalt.vbs
' Autor:  dieseyer@gmx.de
' Auf:    www.dieseyer.de
'
' zeigt den Inhalt von WIM-Dateien an, die mit IMAGEX.EXE 
' erstellt wurden - vergl. 
' http://technet.microsoft.com/de-de/library/cc722145.aspx
' Das VBS kann sich selbst als Standard-Anwendung für 
' WIM-Dateien eintragen
'
' Das VBS benötigt zwingend 
'	IMAGEX.EXE
' und fragt ggf. nach dem Ort, wo sich diese Datei befindet.
'
'***********************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

  Dim ProgrExe		: ProgrExe		= "IMAGEX.EXE"

  Dim fso		: Set fso		= WScript.CreateObject("Scripting.FileSystemObject")
  Dim WSHShell		: Set WSHShell		= WScript.CreateObject("WScript.Shell")
  Dim WSHNet		: Set WSHNet		= WScript.CreateObject("WScript.Network")
  Dim oArgs		: Set oArgs		= Wscript.Arguments

  Dim AktVerz	 	: AktVerz		= Replace( WScript.ScriptFullName, WScript.ScriptName, "" ) ' "\" am Ende
  Dim LogDatei	 	: LogDatei		= WScript.ScriptFullName & ".log"
			  LogDatei		= AktVerz & fso.GetBaseName( WScript.ScriptFullName ) & ".log"

  Dim TempVerz		: TempVerz		= UserTempVerz() & "\"

  Dim XMLDatei	 	: XMLDatei		= TempVerz & fso.GetBaseName( WScript.ScriptFullName ) & ".xml"
  Dim XSLDatei	 	: XSLDatei		= TempVerz & fso.GetBaseName( WScript.ScriptFullName ) & ".xsl"
  Dim CMDDatei	 	: CMDDatei		= TempVerz & fso.GetBaseName( WScript.ScriptFullName ) & ".cmd"
  Dim HTMDatei	 	: HTMDatei		= TempVerz & fso.GetBaseName( WScript.ScriptFullName ) & ".html"

  Dim Titel		: Titel			= WScript.ScriptName
  Dim Txt, Tst
  Dim WIMDatei, ProgrOK

' Call Trace32Log( "-", 0 ) ' erstellt neue LogDatei
  Call Trace32Log( " ", 1 ) ' fügt Leerzeile in LogDatei ein
  Trace32Log " ", 1 ' fügt Leerzeile in LogDatei ein

' WSHShell.Popup "= = = S T A R T = = =", 2, "047 :: " & WScript.ScriptName
  Trace32Log "048 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
  Trace32Log "049 :: PCname: " & WSHNet.ComputerName, 1
  Trace32Log "050 :: Angemeldeter User: " & WSHNet.UserName, 1

  Trace32Log "052 :: AktVerz: " & AktVerz , 1
  Trace32Log "053 :: LogDatei: " & LogDatei, 1
  Trace32Log "054 :: TempVerz: " & TempVerz, 1
  Trace32Log "055 :: XMLDatei: " & XMLDatei, 1
  Trace32Log "056 :: XSLDatei: " & XSLDatei, 1
  Trace32Log "057 :: CMDDatei: " & CMDDatei, 1
  Trace32Log "058 :: HTMDatei: " & HTMDatei, 1

' Anzahl der Argumente testen - min. eins!
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If oArgs.Count < 1 Then    
	Txt = "Das VBS   " & Wscript.ScriptName & "   benötigt einen WIM-Datei als Parameter!" & vbCRLF & vbCRLF
	Txt = Txt & "[Ja]"	& vbTab & vbTab	& "öffnet den ""Datei-Auswahl-Dialog""." & vbCRLF & vbCRLF
	Txt = Txt & "[Nein]"	& vbTab & vbTab	& "trägt dieses VBS als Standard-Anwendung" & vbCRLF & vbTab & vbTab & "für WIM-Dateien ein." & vbCRLF & vbCRLF
	Txt = Txt & "[Abbruch]"	& vbTab 	& "Alles lassen, wie es ist . . . " & vbCRLF & vbTab & vbTab & vbTab & ". . . bei ""Aaaaaaaangst""." & vbCRLF & vbCRLF
	Tst = MsgBox( Txt, 4096 + vbQuestion + vbYesNoCancel, "067 :: " & WScript.ScriptName ) 
	If Tst = vbYes Then	WIMDatei = BFFVerzDateitype( "C:\", "wim" )
	If Tst = vbNo Then	DateiTypRegistrieren "Wim", WScript.ScriptFullName : WScript.Quit 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	If Tst = vbCancel Then	WSHShell.Popup " . . . dann eben nicht!", 10, "071 :: " & WScript.ScriptName & " . . . ist zu Ende.", 48 + 4096 : WScript.Quit
  Else
	WIMDatei = oArgs.item( 0 ) ' Der erste Parameter
	Trace32Log "074 :: Als Prameter erhaltene WIM-Datei: " & WIMDatei, 1
  End If

  If Left( WIMDatei, 7 ) = "Fehler:" Then
	Trace32Log "078 :: Ende " & WScript.ScriptFullName, 1
	WScript.Quit
  End If

  Txt =		WScript.ScriptName & vbCRLF & vbCRLF
  Txt = Txt &	"prüft jetz"	& vbCRLF & vbCRLF
  Txt = Txt &	WIMDatei

  Call PopsUp( Txt, 2 )
'MsgBox Txt, , "087 :: "

  Trace32Log "089 :: Zu prüfende WIM-Datei: " & WIMDatei, 1

' Ist WIMDatei erreichbar?
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If fso.FileExists( WIMDatei ) Then
  Else
	Txt = vbCRLF & vbCRLF & "Die Datei ist nicht erreichbar:" & vbCRLF & vbCRLF & WIMDatei
	WSHShell.Popup "= = = E N D E = = =" & Txt , 15, "096 :: " & WScript.ScriptName, 4096 + vbCritical
	Trace32Log "097 :: Kann nicht ausgeführt werden: " & ProgrExe & " _ " & Tst, 3
	Trace32Log "098 :: Ende " & WScript.ScriptFullName, 1
	WScript.Quit
  End If
  Trace32Log "101 :: WIM-Datei erreichbar: " & WIMDatei, 1


' Erreichbarkeit des Programms   IMAGEX.EXE   prüfen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Call ProgrExeErreichbar
'	' Erreichbarkeit des Programms   IMAGEX.EXE   prüfen
'	' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  '	On Error Resume Next
  '	Tst = WSHShell.Run( ProgrExe, 0, True )
  '	Tst = err.Number & " - " & err.Description
  '	On Error GoTo 0
  '	If InStr( Tst, "2147024894" ) Then Tst = Tst & "Das System kann die angegebene Datei nicht finden."
  '	If Len( Tst ) > 4 Then
	'	Txt = vbCRLF & vbCRLF & "Programm kann nicht gestartet werden: " & vbCRLF & vbCRLF & vbTab & ProgrExe & vbCRLF & vbCRLF & Tst
	'	WSHShell.Popup vbTab & "= = = E N D E = = =" & Txt , 15, "116 :: " & WScript.ScriptName, 4096 + vbCritical
	'	Trace32Log "117 :: Kann nicht ausgeführt werden: " & ProgrExe & " _ " & Tst, 3
	'	Trace32Log "118 :: Ende " & WScript.ScriptFullName, 1
	'	WScript.Quit
  '	End If

' WIM-Datei prüfen und XML-Datei erzeugen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Txt = ProgrExe & " /XML /CHECK /INFO """ & WIMDatei & """ > """ & XMLDatei & """"
  CreateObject("Scripting.FileSystemObject").OpenTextFile( CMDDatei, 2, True).WriteLine Txt
  Trace32Log "126 :: Geschrieben: " & CMDDatei, 1
  Trace32Log "127 ::     " & Txt, 1

  WScript.Sleep 333

  Trace32Log "131 :: Wird gestartet: " & CMDDatei, 1

  Tst = WSHShell.Run( """" & CMDDatei & """", 0, True )

  Trace32Log "135 :: Ist beendet: " & CMDDatei & "; RC: " & Tst, 1


  XSLDateiSchreiben XSLDatei, ""
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Trace32Log "140 :: Datei geschrieben: " & XSLDatei, 1


  XMLXSLalsHTML WIMDatei, XSLDatei, XMLDatei, HTMDatei 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Trace32Log "145 :: Datei geschrieben: " & HTMDatei, 1


' HTML-Datei - Name neu festlegen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Txt = Mid( WIMDatei, 1, InStrRev( WIMDatei, "." ) ) & "html"
  Trace32Log "151 :: Als neue HTMDatei verwendbar: " & Txt & "   ? ? ?", 1
  If fso.FileExists( Txt ) Then
	Trace32Log "153 :: Vorhandene wird gelöscht: " & Txt, 1
	On Error Resume Next
	  fso.DeleteFile Txt
	  Tst = err.Number & " - " & err.Description
	On Error GoTo 0
	If Len( Tst ) > 4 Then 
	  Trace32Log "159 :: Kann nicht gelöscht werden: " & Txt & " _ " & Tst, 2
	End If
  End if  

  If fso.FileExists( Txt ) Then
	Trace32Log "164 :: HTMDatei bleibt unverändert: " & HTMDatei, 1
  Else
	On Error Resume Next
	  fso.CopyFile HTMDatei, Txt, True
	  Tst = err.Number & " - " & err.Description
	On Error GoTo 0
	If Len( Tst ) > 4 Then 
	  Trace32Log "171 :: Kann nicht erstellt werden: " & Txt & " _ " & Tst, 2
	Else
	  Trace32Log "173 :: Erfolgreich kopiert (von .. nach): " & HTMDatei, 1
	  Trace32Log "174 ::      " & Txt, 1
	  Trace32Log "175 ::      " & HTMDatei, 1
	  HTMDatei = Txt
	End If
  End if  

  WScript.Sleep 333

  Trace32Log "182 :: Wird gestartet: " & HTMDatei, 1

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  On Error Resume Next
	CreateObject("WScript.Shell").Run """" & HtmDatei & """", , False
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	Tst = Err.Number & " - " & Err.Description
  On Error GoTo 0
  If Len( Tst ) > 4 Then
	CreateObject("WScript.Shell").Run "mshta.exe """ & HtmDatei & """", , False
  End If

  Trace32Log "194 :: Ist gestartet: " & HTMDatei, 1

' WSHShell.Popup "= = = E N D E = = =", 2, "196 :: " & WScript.ScriptName

Trace32Log "198 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1

Wscript.Quit


'***********************************************************
Function XMLXSLalsHTML( Titel, DateiXSL, DateiXML, DateiHTM )
'***********************************************************
  Dim Txt
  Txt = Txt & vbCRLF & "Titel: " & vbTab & vbTab & Titel
  Txt = Txt & vbCRLF & "DateiXSL: " & vbTab & DateiXSL
  Txt = Txt & vbCRLF & "DateiXML: " & vbTab & DateiXML
  Txt = Txt & vbCRLF & "DateiHTM: " & vbTab & "'" & DateiHTM & "'"
' MsgBox Txt, , "211 :: "

  Txt = ""
  Txt = Txt & vbCRLF & "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
  Txt = Txt & vbCRLF & "<html><head>"
  Txt = Txt & vbCRLF & "</head><body style="" font-size:9Pt; font-weight:normal; font-family:verdana,arial,sans-serif"">"
  Txt = Txt & vbCRLF & "<title>" & Mid( Titel, InStrRev( Titel, "\" ) + 1 ) & "</title>"

' es soll _eine_ HTML-Datei geschrieben werden
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If not DateiHTM = "" Then
'	Txt = Txt & vbCRLF & "<h2>&#160; " & Titel & "</h2>"
	Txt = Txt & vbCRLF & "<span style="" font-size:12Pt; font-weight:bold;"" >&#160; " & Titel & "</span><br><br>"
  End If

  Txt = Txt & vbCRLF & "&#160; Die letzte Änderung (an) der Datei """ & Mid( Titel, InStrRev( Titel, "\" ) + 1 ) & """ "
  Txt = Txt & vbCRLF & " erfolgte am " & CreateObject("Scripting.FileSystemObject").GetFile( Titel ).DateLastModified & ".<br>"

  Dim	xslDoc
  Set	xslDoc = CreateObject("Microsoft.XMLDOM")
	xslDoc.async = false
	xslDoc.load( DateiXSL )
  Dim	xmlDoc
  Set	xmlDoc=CreateObject("Microsoft.XMLDOM")
	xmlDoc.async=false
	xmlDoc.load( DateiXML )
  Txt = Txt & vbCRLF & xmlDoc.transformNode(xslDoc)
  Set	xmlDoc = nothing
  Set	xslDoc = nothing

  Txt = Txt & vbCRLF & "</body></html>"

' es soll _keine_ HTML-Datei geschrieben werden
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If DateiHTM = "" Then
	XMLXSLalsHTML = Txt ' HTML-Code wird übergeben
  Exit Function
  End If

' HTML-Code vervollständigen für HTML-Datei
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Txt = Txt & vbCRLF & "<br><br><span style="" font-size:7Pt; "">"
' Txt = Txt & vbCRLF & "<a href=""http://dieseyer.de"" ><b>" & WScript.ScriptName & "</b>&#160;&#8226;&#160;&copy;&#160;2009&#160;by&#160;dieseyer&#160;&#8226;&#160;all&#160;rights&#160;reserved&#160;&#8226;&#160;<b>www.dieseyer.de</b></a>"
  Txt = Txt & vbCRLF & "<a href=""http://dieseyer.de/scr/wim-inhalt.vbs"" ><b>wim-inhalt.vbs</b></a>"
  Txt = Txt & vbCRLF & "<a href=""http://dieseyer.de/dse-impressum.html"" >&#160;&#8226;&#160;&copy;&#160;2009&#160;by&#160;dieseyer&#160;&#8226;&#160;all&#160;rights&#160;reserved&#160;&#8226;&#160;</a>"
  Txt = Txt & vbCRLF & "<a href=""http://dieseyer.de"" ><b><b>www.dieseyer.de</b></b></a>"
  Txt = Txt & vbCRLF & "</span>"
  Txt = Txt & vbCRLF & "</body></html>"

' HTML-Datei schreiben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  CreateObject("Scripting.FileSystemObject").OpenTextFile( DateiHTM, 2, True).Write Txt

End Function ' XMLXSLalsHTML( DateiXSL, DateiXML, DateiHTM )


'***********************************************************
Sub XSLDateiSchreiben( XSLDatei, VOH )
'***********************************************************
' Diese Prozedur wird in
'	http://dieseyer.de/scr/WIM-BuR.hta
' und
'	http://dieseyer.de/scr/wim_inhalt.vbs
' verwendet - in der HTA-Version sind Buttons in der Anzeige
' erforderlich.

  Dim T
' VOH - VBS oder HTA
' MsgBox VOH, , "279 :: "
  On Error Resume Next
	If VOH = "" Then T = WScript.ScriptFullName
  On Error GoTo 0
  If VOH = "" AND InStr( T, "." ) > 0	Then VOH = "VBS"
  If VOH = ""				Then VOH = "HTA"
' MsgBox VOH, , "285 :: "

	T =		   "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">"
	T = T & vbCRLF & "<xsl:decimal-format name=""de"" decimal-separator="","" grouping-separator="".""/>"
	T = T & vbCRLF & "<xsl:template match=""/"">"
	T = T & vbCRLF & "<span style="" font-size:9Pt; font-weight:normal; font-family:verdana,arial,sans-serif"">"
	T = T & vbCRLF & "<xsl:for-each select=""WIM"">"
	T = T & vbCRLF & "&#160; WIM-Gr&#x00F6;&#x00DF;e:"
	T = T & vbCRLF & "<xsl:choose>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10995116277.76'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,0','de')"" /> GBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '1099511627.776'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,00','de')"" /> GBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10737418.24'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '1073741.824'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '104857.6'"">		<xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,0','de')"" /> kBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10485.76'"">		<xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,00','de')"" /> kBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:otherwise>					<xsl:value-of select=""format-number(TOTALBYTES,'#.##0','de')"" /> Bytes</xsl:otherwise>"
	T = T & vbCRLF & "</xsl:choose>; "
	T = T & vbCRLF & "'<xsl:value-of select=""COMPRESSION"" />' Kompression; "
	T = T & vbCRLF & "</xsl:for-each>"
	T = T & vbCRLF & "das WIM enth&#228;lt "
	T = T & vbCRLF & "<xsl:value-of select=""count(WIM/IMAGE/TOTALBYTES)"" />"
	T = T & vbCRLF & "Images mit zusammen<br />&#160;"
	T = T & vbCRLF & "<xsl:value-of select=""format-number(sum(WIM/IMAGE/TOTALBYTES),'#.##0','de')"" /> Bytes ="
	T = T & vbCRLF & "<xsl:value-of select=""format-number(sum(WIM/IMAGE/TOTALBYTES)*0.0009765625,'#.##0,0','de')"" /> kB ="
	T = T & vbCRLF & "<xsl:value-of select=""format-number(sum(WIM/IMAGE/TOTALBYTES)*0.00000095367431640625,'#.##0,0','de')"" /> MB ="
	T = T & vbCRLF & "<xsl:value-of select=""format-number(sum(WIM/IMAGE/TOTALBYTES)*0.000000000931322574615478515625,'#.##0,00','de')"" /> GB<br />"
	T = T & vbCRLF & "<span style="" font-size:3Pt; height:2.5em; border:0px blue solid; width:98%; "" >&#160;<br /></span>"
	T = T & vbCRLF & "<xsl:for-each select=""WIM/IMAGE"">"
	T = T & vbCRLF & "<span style="" margin-left:-1px; margin-top:-1px;  "
  If VOH = "VBS" Then
	T = T & vbCRLF & "height:3.5em; border:1px red solid; width:98%; padding:0.6em; float:left;"" >"
	T = T & vbCRLF & "<xsl:value-of select=""@INDEX"" />. &#160; "
	T = T & vbCRLF & "<b>""<xsl:value-of select=""NAME"" />""</b><br />"
	T = T & vbCRLF & "&#160; &#160; &#160; Image enth&#228;lt "
  Else
	T = T & vbCRLF & "height:5.6em; border:1px red solid; width:100%; padding:0.6em; float:left;"" >"
	T = T & vbCRLF & "<span style="" font-size: 5Pt; font-weight: bold"" >"
	T = T & vbCRLF & "<input type=""submit"" >"
	T = T & vbCRLF & "<xsl:attribute name=""name""><xsl:value-of select=""@INDEX"" /></xsl:attribute>"
	T = T & vbCRLF & "<xsl:attribute name=""value""><xsl:value-of select=""format-number(@INDEX,'000','de')"" /></xsl:attribute>"
	T = T & vbCRLF & "<xsl:attribute name=""onClick"">SubStart('<xsl:value-of select=""@INDEX"" />')</xsl:attribute>"
	T = T & vbCRLF & "<xsl:attribute name=""class"">InputNr</xsl:attribute>"
	T = T & vbCRLF & "<xsl:attribute name=""accesskey""><xsl:value-of select=""@INDEX"" /></xsl:attribute>"
	T = T & vbCRLF & "</input>"
	T = T & vbCRLF & "</span>"
	T = T & vbCRLF & " &#160;"
	T = T & vbCRLF & "<b>""<xsl:value-of select=""NAME"" />""</b><br />"
	T = T & vbCRLF & "&#160; &#160; &#160; &#160; &#160; &#160;"
	T = T & vbCRLF & "enth&#228;lt "
  End If
	T = T & vbCRLF & "<xsl:value-of select=""format-number(DIRCOUNT,'#.##0','de')"" /> Verzeichnis(se) und"
	T = T & vbCRLF & "<xsl:value-of select=""format-number(FILECOUNT,'#.##0','de')"" /> Datei(en) "
	T = T & vbCRLF & " in"
	T = T & vbCRLF & "<xsl:choose>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10995116277.76'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,0','de')"" /> GBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '1099511627.776'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,00','de')"" /> GBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10737418.24'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '1073741.824'"">	<xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '104857.6'"">		<xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,0','de')"" /> kBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:when test=""TOTALBYTES &gt; '10485.76'"">		<xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,00','de')"" /> kBytes</xsl:when>"
	T = T & vbCRLF & "<xsl:otherwise>					<xsl:value-of select=""format-number(TOTALBYTES,'#.##0','de')"" /> Bytes</xsl:otherwise>"
	T = T & vbCRLF & "</xsl:choose>;<br />"
  If VOH = "VBS" Then
	T = T & vbCRLF & "&#160; &#160; &#160; "
  Else
	T = T & vbCRLF & "&#160; &#160; &#160; &#160; &#160; &#160; "
  End If
	T = T & vbCRLF & "<xsl:value-of select=""DESCRIPTION"" /> "
	T = T & vbCRLF & "</span>"
	T = T & vbCRLF & "</xsl:for-each>"
	T = T & vbCRLF & "<span style="" font-size:3Pt; height:2em; border:0px blue solid; width:98%; "" >&#160;<br /></span>"
	T = T & vbCRLF & "<xsl:for-each select=""WIM"">"
	T = T & vbCRLF & "<br />&#160; GUID: <xsl:value-of select=""GUID"" /> &#160;   "
	T = T & vbCRLF & "(<xsl:value-of select=""PARTNUMBER"" /> -    "
	T = T & vbCRLF & "<xsl:value-of select=""TOTALPARTS"" /> - "
	T = T & vbCRLF & "<xsl:value-of select=""ATTRIBUTES"" />)  "
	T = T & vbCRLF & "</xsl:for-each>"
	T = T & vbCRLF & "</span>"
	T = T & vbCRLF & "</xsl:template>"
	T = T & vbCRLF & "</xsl:stylesheet>"

  If VOH = "VBS" Then
	CreateObject("Scripting.FileSystemObject").OpenTextFile( XSLDatei, 2, True).Write T
  Exit Sub
  End If

  Trace32Log "371 :: Datei soll geschrieben werden: " & XSLDatei, 1
  CreateObject("Scripting.FileSystemObject").OpenTextFile( XSLDatei, 2, True).Write T
  Trace32Log "373 :: Datei ist geschrieben: " & XSLDatei, 1

  Trace32Log "375 :: Beendet 'XSLDateiSchreiben( XSLDatei )'", 1

End Sub ' XSLDateiSchreiben( XSLDatei, VOH )


'*** v9.4 *** www.dieseyer.de ******************************
Function UserTempVerz
'***********************************************************
' aus 'Scriptomatic v2.0' by 'The MS Scripting Guys'
  Dim objWMIService	: Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
  Dim colItems		: Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Environment", "WQL", &h10 + &h20 )
  Dim objItem
  For Each objItem In colItems
	If InStr( UCase( objItem.UserName ), UCase( CreateObject("WScript.Network").Username ) ) > 0 Then
'	  If objItem.SystemVariable = vbFalse Then UserTempVerz = objItem.VariableValue : Exit For
	  If InStr( UCase( objItem.VariableValue ), "TEMP" ) > 0 Then UserTempVerz = objItem.VariableValue : Exit For
	  If InStr( UCase( objItem.VariableValue ), "TMP" ) > 0 Then UserTempVerz = objItem.VariableValue : Exit For
	End If
  Next
' MsgBox UserTempVerz, , "394 :: "
  If InStr( UCase( UserTempVerz ), "%USERPROFILE%" ) = 1 Then
	UserTempVerz = Mid( UserTempVerz, Len( "%USERPROFILE%" ) + 1 )
	UserTempVerz = CreateObject("WScript.Shell").Environment("PROCESS")("USERPROFILE") & UserTempVerz
  End If

' MsgBox "UserTempVerz: " & UserTempVerz, , "400 :: " : WScript.Quit
End Function ' UserTempVerz


'*** v9.4 *** www.dieseyer.de ******************************
Function BFFStartVerzeichnis( Verz )
'***********************************************************
' aus http://www.source-center.de/forum/showthread.php?t=25743
' http://www.coding-board.de/board/showthread.php?t=19261
' Set oFolder = oFSO.GetFolder("C:\")

  Dim Dialog		: Set Dialog = CreateObject("UserAccounts.CommonDialog")
  Dialog.Filter = "WIM Files|*.wim|All Files|*.*" ' zeigt nur *.txt
' Dialog.Filter = "Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*" ' zeigt nur *.xls
' Dialog.Filter = "Alle Dateien|*.*" ' zeigt nur *.* - also ALLES
' Dialog.Filter = "Textdateien|*.txt|Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*"
  Dialog.FilterIndex = 1 ' von den drei auswählbaren Filtern wird der 2. eingesetzt
  Dialog.InitialDir = Verz
  Dialog.Flags = &H4 ' HIDEREADONLY'
  Dialog.ShowOpen
  BFFStartVerzeichnis = Dialog.FileName

End Function ' BFFStartVerzeichnis( Verz )

'*** v9.5 *** www.dieseyer.de ******************************
Sub DateiTypRegistrieren( DateiTyp, Progr )
'***********************************************************
' in VBS und HTA verwendbar

  Dim WSHShell		: Set WSHShell		= CreateObject("WScript.Shell")
  Dim fso		: Set fso		= CreateObject("Scripting.FileSystemObject")

  Dim ZielProgr		: ZielProgr		= WSHShell.ExpandEnvironmentStrings("%ProgramFiles%") & "\dieseyer.de\" & fso.GetFileName( Progr )
  Dim Zielverz		: Zielverz		= fso.GetParentFolderName( ZielProgr )

  Dim HilfsProgr		: HilfsProgr		= ""
  If fso.GetExtensionName( LCase( Progr ) ) = "vbs" Then HilfsProgr = "wscript.exe " 
  If fso.GetExtensionName( LCase( Progr ) ) = "hta" Then HilfsProgr = "mshta.exe " 

  DateiTyp = LCase( DateiTyp )

  Dim Txt, Tst

  Trace32Log "443 :: DateiTyp: " & DateiTyp, 1
  Trace32Log "444 :: Progr: " & Progr, 1
  Trace32Log "445 :: HilfsProgr: " & HilfsProgr, 1
  Trace32Log "446 :: DateiTyp: " & DateiTyp, 1
  Trace32Log "447 :: Zielverz: " & Zielverz, 1

' Ziel-Verzeichnis für das Progr ggf. anlegen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If fso.FolderExists( Zielverz ) Then
  Else
  Trace32Log "453 :: Zielverz soll anlegt werden: " & Zielverz, 1
  On Error Resume Next
	fso.CreateFolder Zielverz
	Tst = err.Number & " - " & err.Description
  On Error GoTo 0
  	If Len( Tst ) > 4 Then 
	Txt = vbCRLF & vbCRLF & "Verzeichnis kann nicht ertellt werden:" & vbCRLF & vbCRLF & Tst
	WSHShell.Popup "= = = E N D E = = =" & Txt , 15, "460 :: Sub 'DateiTypRegistrieren'", 4096 + vbCritical
	Trace32Log "461 :: Verzeichnis kann nicht ertellt werden: " & Zielverz & " _ " & Tst, 3
	Trace32Log "462 :: Ende - Sub 'DateiTypRegistrieren'", 3
	Exit Sub
	Else
	Trace32Log "465 :: Erstellt: " & Zielverz & " _ " & Tst, 1
	End If
  End If

' Wenn Progr erreichbar, Prog ins Ziel-Verzeichnis kopieren
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Wenn Progr NICHT erreichbar ist, wird davon ausgegangen, 
' dass das Prog über die Umgebungsvariable PATH vom 
' Betriebssystem gefunden wird.
  If not fso.FileExists( Progr ) Then
	ZielProgr = Progr
	Trace32Log "476 :: ZielProgr (evtl. neu) festgelegt: " & ZielProgr, 1
  Else
	Trace32Log "478 :: Datei soll kopiert werden:   (von..nach)", 1
	Trace32Log "479 ::     " & Progr, 1
	Trace32Log "480 ::     " & ZielProgr, 1
  On Error Resume Next
	fso.CopyFile Progr, ZielProgr, true
	Tst = err.Number & " - " & err.Description
  On Error GoTo 0
	  If Len( Tst ) > 4 Then 
	  Txt = vbCRLF & vbCRLF & "Datei kann nicht ertellt werden:" & vbCRLF & vbCRLF & ZielProgr
	  WSHShell.Popup "= = = E N D E = = =" & Txt , 15, "487 :: Sub 'DateiTypRegistrieren'", 4096 + vbCritical
	  Trace32Log "488 :: Kann nicht erstellt werden: " & ZielProgr & " _ " & Tst, 3
	  Trace32Log "489 :: Ende - Sub 'DateiTypRegistrieren'", 3
	  Exit Sub
	Else
	  Trace32Log "492 :: Erstellt: " & ZielProgr & " _ " & Tst, 1
	End If
  End If

  Txt = "HKLM\SOFTWARE\Classes\." & DateiTyp & "\"
  WSHShell.RegWrite Txt, DateiTyp & "_auto_file"
  Trace32Log "498 :: RegWrite erfolgreich: " & Txt, 1

  Txt = "HKLM\SOFTWARE\Classes\" & DateiTyp & "_auto_file\shell\open\command\"
  WSHShell.RegWrite Txt, HilfsProgr & """" & ZielProgr & """ " & chr(34) & "%1" & chr(34)
  Trace32Log "502 :: RegWrite erfolgreich: " & Txt, 1

  Txt = 	vbTab & ZielProgr & vbCRLF & vbCRLF 
  Txt = Txt & 	"wurde als Standard-Anwendung für   '" & DateiTyp & "'  -Dateien registriert." & vbCRLF & vbCRLF
  Txt = Txt & 	"Künftig genügt es, eine Datei mit der Endung ." & DateiTyp & " doppelt an zu" & vbCRLF 
  Txt = Txt & 	"klicken und die Anwendung startet mit dieser Datei als Parameter.          " & vbCRLF 
  WSHShell.PopUp Txt, 30, "508 :: Sub 'DateiTypRegistrieren'", vbInformation

  Trace32Log "510 :: Ende - Sub 'DateiTypRegistrieren'", 1

End Sub ' DateiTypRegistrieren( DateiTyp, Progr )


'***********************************************************
Function ProgrExeErreichbar
'***********************************************************
  Dim fso		: Set fso		= CreateObject("Scripting.FileSystemObject")
  Dim WSHShell		: Set WSHShell		= CreateObject("WScript.Shell")
  Dim Txt, Tst

  Txt = TempVerz & ProgrExe
  If fso.FileExists( Txt ) Then ProgrExe = Txt	 : ProgrExeErreichbar = vbTrue	: ProgrOK = vbTrue	: Exit Function

  Txt = AktVerz & ProgrExe
  If fso.FileExists( Txt ) Then ProgrExe = Txt	 : ProgrExeErreichbar = vbTrue	: ProgrOK = vbTrue	: Exit Function

  Txt = RemoteWinDir( "." ) & "\" & ProgrExe
  If fso.FileExists( Txt ) Then ProgrExe = Txt	 : ProgrExeErreichbar = vbTrue	: ProgrOK = vbTrue	: Exit Function

  Txt = RemoteWinDir( "." ) & "\System32\" & ProgrExe
  If fso.FileExists( Txt ) Then ProgrExe = Txt	 : ProgrExeErreichbar = vbTrue	: ProgrOK = vbTrue	: Exit Function

  Txt = RemoteWinDir( "." ) & "\SysWOW64\" & ProgrExe
  If fso.FileExists( Txt ) Then ProgrExe = Txt	 : ProgrExeErreichbar = vbTrue	: ProgrOK = vbTrue	: Exit Function

' Suchen-Dialog, weil imagex.exe nicht gefunden
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Txt = vbCRLF & vbCRLF & "Programm kann nicht gestartet werden bzw. ist nicht erreichbar: " & vbCRLF & vbCRLF & vbTab & ProgrExe & vbCRLF & vbCRLF & "Soll der Datei-Suchen-Dialog geöffnet werden?"
  Tst = MsgBox( Txt, vbQuestion + vbYesNo, "540 :: " & Titel )
  If Tst = vbYes Then 
	Txt = BFFVerzDateitype( AktVerz, "exe" )
	Tst = InStrRev( Txt, "\" )
	If Tst > 0 Then Tst = UCase( Mid( Txt, Tst + 1 ) )
	If ProgrExe = Tst Then
	  ProgrExe = Txt
	  Txt = RemoteWinDir( "." ) & "\System32\" & Tst
	  ProgrExeErreichbar	= vbTrue
	  ProgrOK		= vbTrue
'	  document.all.InfoTxt.innerHTML = "550 :: " & "vbTrue" & " &#160; &#160; " & ProgrExe
	  Tst = MsgBox( ProgrExe & vbCRLF & vbCRLF & "in folgendes Verzeichnis kopieren:" & vbCRLF & vbCRLF & Txt, vbQuestion + vbYesNo, "551 :: " & Titel )
	  If Tst = vbYes Then 
	  	fso.CopyFile ProgrExe, Txt, True 
	  	ProgrExe = Txt 
	  	MsgBox "Erstellt: " & vbCRLF & vbCRLF & ProgrExe, vbInformation, "555 :: " & Titel 
	  End If
  Exit Function
	End If 
  End If 

	
' imagex.exe nicht gefunden
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Txt = vbCRLF & vbCRLF & "Programm kann nicht gestartet werden bzw. ist nicht erreichbar: " & vbCRLF & vbCRLF & vbTab & ProgrExe & vbCRLF & vbCRLF
  WSHShell.Popup vbTab & "= = = F E H L E R = = =" & Txt , 15, "565 :: " & Titel, 4096 + vbCritical
  ProgrOK = vbFalse
  ProgrExeErreichbar = vbFalse

End Function ' ProgrExeErreichbar( Exe )


'*** v10.3 *** www.dieseyer.de *****************************
Function RemoteWinDir( PCName )
'***********************************************************
' http://msdn2.microsoft.com/en-us/library/aa394596(vs.85).aspx
' ermittelt %WINDIR% == %SYSTEMROOT%; häufig C:\Windows
  Dim objWMIService, colOperatingSystems, objOperatingSystem, Tst
  Dim WindowsDirectory, SystemDirectory

  On Error Resume Next
  err.Clear
  Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PCName & "\root\cimv2")
  Tst = err.Number & " - " & err.Description
  On Error Goto 0
  If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-Sys " & Tst : Exit Function

  On Error Resume Next
  err.Clear
  Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
  Tst = err.Number & " - " & err.Description
  On Error Goto 0
  If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-SysOS " & Tst : Exit Function


  On Error Resume Next
  err.Clear
  For Each objOperatingSystem in colOperatingSystems
  Tst = err.Number & " - " & err.Description
  On Error Goto 0
  If Len( Tst ) > 4 Then : RemoteWinDir = "Fehler: WMI-SysDir " & Tst : Exit Function
	WindowsDirectory = objOperatingSystem.WindowsDirectory
	SystemDirectory = objOperatingSystem.SystemDirectory
  Next

  Set colOperatingSystems = nothing
  Set objWMIService = nothing
  If WindowsDirectory = "" Then
	SystemDirectory = UCase( SystemDirectory )
	If InStr( SystemDirectory, "\SYSTEM32" ) Then WindowsDirectory = Replace( SystemDirectory, "\SYSTEM32", "" )
  End If
  RemoteWinDir = WindowsDirectory
' RemoteWinDir = "%..root%: " & RemoteWinDir
End Function ' RemoteWinDir( PCName )


'*** v10.8 *** www.dieseyer.de ******************************
Function BFFAusWahlOCX( StartVerz, DateiType )
'***********************************************************
' http://www.access-paradies.de/tipps/dateiauswahldialog.php

  Dim fso		: Set fso		= CreateObject("Scripting.FileSystemObject")
  Dim Tst
  Tst = Replace( WScript.ScriptFullName, WScript.ScriptName, "" ) & "comdlg32.ocx"
  If not fso.FileExists( Tst ) Then
  	MsgBox "Datei fehlt: " & vbCRLF & vbCRLF & Tst, 4096 + vbCritical, "625 :: " & Titel
  	BFFAusWahlOCX = "Fehler: '" & Tst & "' fehlt!"
  Exit Function
  Else
'  	MsgBox "Datei vorhanden: " & vbCRLF & vbCRLF & Tst, 4096 + vbInformation, "629 :: " & Titel
  End If

  On Error Resume Next
  CreateObject("Wscript.Shell").Run "regsvr32.exe /s " & AktVerz & "\comdlg32.ocx", 1, true
  On Error Goto 0

  CreateObject("WScript.Shell").RegWrite "HKCR\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905\", "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj", "REG_SZ"

  Tst = CreateObject("WScript.Shell").ExpandEnvironmentStrings( "%ALLUSERSPROFILE%" ) ' : MsgBox Tst, , "638 :: "

  If fso.FolderExists( "R:\" ) Then  Tst = "R:\Documents and Settings"				' : MsgBox Tst, , "640 :: "
  If not fso.FolderExists( Tst ) Then fso.CreateFolder Tst	' : MsgBox "Erstellt: " & Tst, , "641 :: "

  Tst = Tst & "\Default User"		' : MsgBox Tst, , "643 :: "
  If not fso.FolderExists( Tst ) Then fso.CreateFolder Tst	' : MsgBox "Erstellt: " & Tst, , "644 :: "

' MsgBox Tst, , "646 :: "
  If fso.FolderExists( Tst ) Then
	Tst = Tst & "\Desktop"
	If not fso.FolderExists( Tst ) Then fso.CreateFolder Tst : Trace32Log "649 :: Erstellt: " & Tst, 1 ' : MsgBox "Erstellt: " & vbCRLF & vbCRLF & Tst, , "649 :: "
  End If

  If not Right( StartVerz, 1 ) = "\" Then StartVerz = StartVerz & "\"
' MsgBox "'" & StartVerz & "'", , "653 :: "

  DateiType = LCase( DateiType )

  Dim objDialog	: Set objDialog = CreateObject("MSComDlg.CommonDialog")
' objDialog.Filter = "Alle Dateien (*.*)*.*"
' objDialog.Filter = "ImageX-Dateien (*.wim)|*.wim|Alle Dateien (*.*)|*.*"
' objDialog.Filter = "ImageX-Dateien (*.wim)|*.wim"
  objDialog.Filter = UCase( DateiType ) & "-Dateien (*." & DateiType & ")|*." & DateiType
' objDialog.Filter = "Textdateien (*.txt)|*.txt"
  objDialog.DialogTitle = "663 :: " & UCase( DateiType ) & " auswählen . . . "
  objDialog.InitDir = StartVerz
  objDialog.MaxFileSize = 256
' objDialog.Flags = &H4 + &H400
  objDialog.Flags = &H80000 OR &H4 OR &H2000 ' + &H800 + &H8
' objDialog.Flags = &H2000 ' + &H800 + &H8
' objDialog.FilterIndex = 1
'	cdlOFNAllowMultiselect		&H200		Ermöglicht, dass im Listenfeld Dateiname mehrere Dateien ausgewählt werden.
'							Die FileName-Eigenschaft gibt einen String zurück, der alle ausgewählten
'							Dateinamen enthält (die Namen sind im String durch Leerzeichen voneinander getrennt).
'	cdlOFNCreatePrompt		&H2000		Fragt den Benutzer, ob eine Datei angelegt werden soll, die noch nicht existiert.
'							Dieses Flag setzt automatisch die Flags cdlOFNPathMustExist und cdlOFNFileMustExist.
'	cdlOFNExplorer			&H80000		Verwendet das dem Explorer ähnliche Dialogfeld zum Öffnen von Dateien.
'	cdlOFNExtensionDifferent	&H400		Weist darauf hin, dass sich die Dateinamenerweiterung des zurückgegebenen Dateinamens
'							von der in der DefaultExt-Eigenschaft angegebenen Erweiterung unterscheidet. Dieses
'							Flag wird nicht gesetzt, wenn die DefaultExt-Eigenschaft Null enthält, wenn die
'							Erweiterungen übereinstimmen, oder wenn die Datei keine Erweiterung hat. Man kann
'							den Wert dieses Flags überprüfen, nachdem das Dialogfeld geschlossen wurde.
'	cdlOFNFileMustExist		&H1000		Die Benutzer dürfen nur Dateinamen eingeben, die existieren. Wenn dieses Flag gesetzt
'							ist und der Benutzer gibt einen ungültigen Dateinamen ein, wird eine Warnung angezeigt.
'							Dieses Flag setzt automatisch das Flag cdlOFNPathMustExist.
'	cdlOFNHelpButton		&H10		Zeigt die Hilfe-Schaltfläche für das Dialogfeld an.
'	cdlOFNHideReadOnly		&H4 		Verbirgt das Kontrollkästchen Mit Schreibschutz öffnen.
'	cdlOFNLongNames			&H200000	Erlaubt lange Dateinamen.
'	cdlOFNNoChangeDir		&H8		Zwingt das Dialogfeld, das aktuelle Verzeichnis so zu setzen, wie es beim Öffnen des
'							Dialogfelds gesetzt war.
'	cdlOFNNoDereferenceLinks	&H100000	Verbietet die Dereferenzierung von Shell-Links (auch als Shortcuts bezeichnet). Standardmäßig
'							bewirkt die Auswahl eines Shell-Links, dass dieser von der Shell dereferenziert wird.
'	cdlOFNNoLongNames		&H40000		Verbietet lange Dateinamen.
'	cdlOFNNoReadOnlyReturn		&H8000		Spezifiziert, dass die zurückgegebene Datei das Attribut Read-Only nicht gesetzt hat und
'							sich nicht in einem schreibgeschützten Verzeichnis befindet.
'	cdlOFNNoValidate		&H100		Erlaubt ungültige Zeichen im zurückgegebenen Dateinamen.
'	cdlOFNOverwritePrompt		&H2		Bewirkt, dass das Dialogfeld Speichern unter eine Warnung erzeugt, wenn der angegebene
'							Dateiname bereits existiert. (Die Benutzer können dann wählen, ob die Datei überschrieben
'							werden soll.)
'	cdlOFNPathMustExist		&H800		Die Benutzer dürfen nur gültige Pfade eingeben. Wenn dieses Flag gesetzt ist und die Benutzer
'							einen ungültigen Pfad eingeben, erscheint eine Warnung.
'	cdlOFNReadOnly			&H1		Markiert das Kontrollkästchen Mit Schreibschutz öffnen, wenn das Dialogfeld erzeugt wird.
'							Dieses Flag gibt außerdem den Status des Kontrollkästchens Mit Schreibschutz öffnen nach dem
'							Schließen des Dialogfelds an.
'	cdlOFNShareAware		&H4000		Zeigt an, dass mögliche Freigabe-Fehler ignoriert werden.

  objDialog.ShowOpen()
' intResult = objDialog.ShowOpen()
  BFFAusWahlOCX = objDialog.Filename
  Set objDialog = nothing

End Function ' BFFAusWahlOCX( StartVerz, DateiType )


'*** v10.8 *** www.dieseyer.de *******************************
Function BFFVerzDateitype( Verz, DateiType )
'***********************************************************
' aus http://www.source-center.de/forum/showthread.php?t=25743
' http://www.coding-board.de/board/showthread.php?t=19261
' Set oFolder = oFSO.GetFolder("C:\")
' Exit Function
  Dim Tst, Dialog

' neu in v10.8
  On Error Resume Next
	err.Clear
	Set Dialog = CreateObject("UserAccounts.CommonDialog")
	Tst = err.Number & " - " & err.Description
  On Error Goto 0
  If Len( Tst ) > 4 Then
	BFFVerzDateitype = BFFAusWahlOCX( Verz, DateiType )
  Exit Function
  End If

' objDialog.Filter = "ImageX-Dateien (*.wim)|*.wim|Alle Dateien (*.*)|*.*"
  Dialog.Filter = """" & UCase( DateiType ) & """ Dateien|*." & DateiType & "|All Files|*.*" ' zeigt nur *.txt
  Dialog.FilterIndex = 1
  Dialog.InitialDir = Verz
  Dialog.Flags = &H4 ' HIDEREADONLY
  Dialog.ShowOpen
  BFFVerzDateitype = Dialog.FileName
End Function ' BFFVerzDateitype( Verz, DateiType )


'*** v9.5 *** www.dieseyer.de *******************************
Function PopsUp ( TxT, Dauer )
'************************************************************
' in VBS und HTA verwendbar
' ACHTUNG! Ausserhalb und vor dem ersten Aufruf dieser Prozedur
' muss einmal   "Set Prog_PP = nothing"   stehen, sonst wird es
' mit dem "prog.terminate" innerhalb der Prozedur nichts!
' 
' ACHTUNG! Alle Variablen müssen ausserhalb dieser Prozedur
' deklariert werden (also folgende Zeilen an den Skript-Anfang):
' Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP 
' Set Prog_PP = nothing

  Dim Fso_PP		: Set Fso_PP		= CreateObject("Scripting.FileSystemObject") 
' VBSDatei_PP     =                              WSHShell.ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS" 
  Dim VBSDatei_PP	: VBSDatei_PP		= CreateObject("WScript.Shell").ExpandEnvironmentStrings("%Temp%") & "\" & Fso_PP.GetBaseName( WScript.ScriptName ) & "-MSG.VBS" 

  Dim FileOut_PP
  On Error Resume Next
    Prog_PP.terminate
'   If not err.Number = 0 then MsgBox err.Description
  On Error GoTo 0

  If Txt = "" then    
'   On Error Resume Next
      IF Fso_PP.FileExists(VBSDatei_PP) then Fso_PP.DeleteFile(VBSDatei_PP) ' löscht das MSG-VBScript 
'   On Error GoTo 0
      Exit Function   
  End If 

  Txt = Replace( Txt, vbCRLF, """ & vbCRLF & """ )

  Set FileOut_PP = Fso_PP.OpenTextFile(VBSDatei_PP, 2, true)         ' MSG-VBScript öffnen mit neu anlegen 
      FileOut_PP.WriteLine "WScript.CreateObject(""WScript.Shell"").Popup """ & Txt & """ , " & Dauer & ", """ & Fso_PP.GetFileName( VBSDatei_PP ) & " "" , vbSystemModal " 
'    AKTIVvbs.WriteLine "WshShell.Popup Txt, 2, Titel, vbSystemModal "

      FileOut_PP.Close
  Set FileOut_PP = Nothing 
  Set Fso_PP      = Nothing 
 
  On Error Resume Next
	Set Prog_PP = CreateObject("WScript.Shell").exec( "WScript """ & VBSDatei_PP & """" )
'	If not err.Number = 0 then MsgBox err.Description
  On Error GoTo 0

End Function ' PopsUp ( TxT, Dauer )


'*** v9.C *** www.dieseyer.de ******************************
Sub Trace32Log( LogTxt, ErrType )
'***********************************************************
' in VBS und HTA verwendbar
' Aufbau einer LOG-Datei für trace32.exe ( SMS Trace;
' ALLES in einer Zeile!):
' <![LOG[...]LOG]!>
' <
'	time="08:12:54.309+-60"
'	date="03-14-2008"
'	component="SrcUpdateMgr"
'	context=""
'	type="0"
'	thread="1812"
'	file="productpackage.cpp:97"
' >
'
'	"context="	Info wird nicht angezeigt
'	type="0"	normale Zeie => NEUE LOG-DATEI - ggf. alte überschreiben !!!!!!!!!!!!
'	type="1"	normale Zeie
'	type="2"	gelbe Zeie
'	type="3"	rote Zeie
'	type="F"	rote Zeie

'	"thread="	kann eine Dezimalzahl aufnehmen; trace32 zeigt
'           neben der Dezimalzahl in Klammern die entspr.
'           Hexadezimalzahl an - z.B. "33 (0x21)"
'	"file="	wird in "Source:" angezeigt
'

  Dim fso         : Set fso       = CreateObject("Scripting.FileSystemObject")
  Dim LogDateiX, TitelX, Tst, Nr

  On Error Resume Next
	Tst = KeineLog
  On Error Goto 0
  If UCase( Tst ) = "JA" Then Exit Sub

  On Error Resume Next
	TitelX = Titel	' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
	TitelX = title	' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
	If Len( TitelX ) < 2	Then TitelX = document.title		' .hta
	If Len( TitelX ) < 2	Then TitelX = WScript.ScriptName	' .vbs
  On Error Goto 0

  On Error Resume Next
	LogDateiX = LogDatei	' wurde die Variable 'LogDatei' nicht außerhalb der Prozedur definiert
	If Len( LogDateiX ) < 2	Then LogDateiX = WScript.ScriptFullName & ".log"	' .vbs
	If Len( LogDateiX ) < 2	Then LogDateiX = TitelX & ".log"			' .hta
  On Error Goto 0

  Nr = 0 ' Wenn in Thread die Zeilennummer stehen soll:
  Nr = 999999
  If Nr = 0   AND   InStr( LogTxt, " :" & ": " ) > 0 Then
' Wenn in Thread die Zeilennummer stehen soll - Voraussetzung
' ist eine ZeilenNr. im Format '22 :: '
	Nr = LogTxt
	Nr = Mid( Nr, 1, InStrRev( Nr, " :" & ": "	) -1 )		' nach der Zeilennummer
	Nr = Mid( Nr, InStrRev( Nr, " "	) + 1 )    			' vor der Zeilennummer
	On Error Resume Next : Tst = Int( Nr ) : On Error Goto 0	' Zeilennummer als (Integer) Zahl
	Do    ' Tst für Vergleich auf gleiche Länge wie Nr anpassen
	  If Len( Tst ) = Len( Nr ) Then Exit Do
	  Tst = "0" & Tst
	Loop

	If "x" & Tst = "x" & Nr Then
	  LogTxt = Replace( LogTxt, Tst & " :" & ": ", "" )
	  Nr = Int( Nr )
	End If
  End If
  If Nr = 999999 Then Nr = 0


' Zwei Nachkommastellen (nach Sekunden) der aktuellen Zeit
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Tst = Timer()   				' timer() in USA: 1234.22
  Tst = Replace( Tst, "," , ".")        	' timer() in Deutschland: 123454,12
  If InStr( Tst, "." ) = 0 Then Tst = Tst & ".000"
  Tst = Mid( Tst, InStr( Tst, "." ), 4 )
  If Len( Tst ) < 3 Then Tst = Tst & "0"

' Zeitzone ermitteln - neu (v9.C) und immer richtig(er)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Dim AktDMTF : Set AktDMTF = CreateObject("WbemScripting.SWbemDateTime")
  AktDMTF.SetVarDate Now(), True : Tst = Tst & Mid( AktDMTF, 22 ) ' : MsgBox Tst, , "875 :: "
' MsgBox "AktDMTF: '" & AktDMTF & "'", , "876 :: "
  Set AktDMTF = nothing

  LogTxt = "<![LOG[" & LogTxt & "]LOG]!>"
  LogTxt = LogTxt & "<"
  LogTxt = LogTxt & "time=""" & Hour( Time() ) & ":" & Minute( Time() ) & ":" & Second( Time() ) & Tst & """ "
  LogTxt = LogTxt & "date=""" & Month( Date() ) & "-" & Day( Date() ) & "-" & Year( Date() ) & """ "
  LogTxt = LogTxt & "component=""" & TitelX & """ "
  LogTxt = LogTxt & "context="""" "
  LogTxt = LogTxt & "type=""" & ErrType & """ "
  LogTxt = LogTxt & "thread=""" & Nr & """ "
  LogTxt = LogTxt & "file=""dieseyer.de"" "
  LogTxt = LogTxt & ">"

			Tst = 8 ' LOG-Datei erweitern
  If ErrType = 0 Then	Tst = 2 ' LOG-Datei erneuern (alte löschen, neue erstellen)

	On Error Resume Next
  If     LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
  If not LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
	On Error Goto 0

  Set fso     = Nothing

End Sub ' Trace32Log( LogTxt, ErrType )