http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** 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>  " & Titel & "</h2>"
Txt = Txt & vbCRLF & "<span style="" font-size:12Pt; font-weight:bold;"" >  " & Titel & "</span><br><br>"
End If

Txt = Txt & vbCRLF & "  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> • © 2009 by dieseyer • all rights reserved • <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"" > • © 2009 by dieseyer • all rights reserved • </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 & "  WIM-Größe:"
T = T & vbCRLF & "<xsl:choose>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '10995116277.76'""> <xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,0','de')"" /> GBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '1099511627.776'""> <xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,00','de')"" /> GBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '10737418.24'""> <xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '1073741.824'""> <xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '104857.6'""> <xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,0','de')"" /> kBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '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ält "
T = T & vbCRLF & "<xsl:value-of select=""count(WIM/IMAGE/TOTALBYTES)"" />"
T = T & vbCRLF & "Images mit zusammen<br /> "
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%; "" > <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"" />.   "
T = T & vbCRLF & "<b>""<xsl:value-of select=""NAME"" />""</b><br />"
T = T & vbCRLF & "      Image enthä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 & "  "
T = T & vbCRLF & "<b>""<xsl:value-of select=""NAME"" />""</b><br />"
T = T & vbCRLF & "           "
T = T & vbCRLF & "enthä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 > '10995116277.76'""> <xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,0','de')"" /> GBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '1099511627.776'""> <xsl:value-of select=""format-number(TOTALBYTES*0.000000000931322574615478515625,'#.##0,00','de')"" /> GBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '10737418.24'""> <xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '1073741.824'""> <xsl:value-of select=""format-number(TOTALBYTES*0.00000095367431640625,'#.##0,00','de')"" /> MBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '104857.6'""> <xsl:value-of select=""format-number(TOTALBYTES*0.0009765625,'#.##0,0','de')"" /> kBytes</xsl:when>"
T = T & vbCRLF & "<xsl:when test=""TOTALBYTES > '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 & "      "
Else
T = T & vbCRLF & "            "
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%; "" > <br /></span>"
T = T & vbCRLF & "<xsl:for-each select=""WIM"">"
T = T & vbCRLF & "<br />  GUID: <xsl:value-of select=""GUID"" />   "
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" & "     " & 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 )

http://dieseyer.de • all rights reserved • © 2011 v11.4