PDA

Archiv verlassen und diese Seite im Standarddesign anzeigen : Verlaufsbalken



derblume
03.05.2007, 15:00 / @583
Hallo.

Nachdem hier ja schon mehrfach die Frage nach einem Verlaufsbalken aufgekommen war, stelle ich Euch mal eine IE-Basierte Lösung vor.
Ist nicht von mir, ein Kollege hat die Lösung(en) im Web gefunden.
Es sieht auf jeden Fall ziemlich elegant aus, was man damit machen kann, ergibt sich aus dem Quellcode.
Viel Spass damit und

munter bleiben
db

1. Lösung von Richard L. Mueller


' IEDisplay.vbs
' VBScript program to use Microsoft Internet Explorer to display a
' dynamic dialog box indicating program progress.
'
' ----------------------------------------------------------------------
' Copyright (c) 2002 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - November 11, 2002
' Version 1.1 - February 19, 2003 - Standardize Hungarian notation.
' Program uses Internet Explorer to display a dialog box whose message
' changes to reflect progress in the program. The user can abort the
' program by closing the dialog box. The program requires Microsoft
' Internet Explorer on the client. The Wscript.Sleep command requires
' Windows Script Host (WSH) 5.1 or greater.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.
Option Explicit
Dim objIE, objShell, k, strIETitle, blnFlag
' Set IE display box title. Dashes ("-") are to move the Microsoft title
' appended to the title we specify out of view.
' blnFlag is set to False when the user closes the IE display box.
strIETitle = "Test Program" & String(40, "-")
blnFlag = True
Set objShell = CreateObject("WScript.Shell")
' Initialize display box with initial message
InitIE "Program Initializing"
' Display progress with counter.
' Program can be aborted by closing the display box.
Wscript.Sleep 2000
For k = 0 To 10
MsgIE "Iteration " & k & vbCrLf & "To abort, close this box"
Wscript.Sleep 1000
If (blnFlag = False) Then
Wscript.Echo "Program Aborted after " & k & " iterations"
Wscript.Quit
End If
Next
MsgIE "Loop complete"
' Display final message
Wscript.Sleep 2000
MsgIE "Program Finished"
If (blnFlag = False) Then
Wscript.Echo "Program Aborted after iterations complete"
Wscript.Quit
End If
' Close display box
Wscript.Sleep 2000
MsgIE "IE_Quit"
' Clean Up.
Set objIE = Nothing
Set objShell = Nothing
Wscript.Echo "Done"
Sub MsgIE(strMsg)
' Subroutine to display message in IE box and detect when the
' box is closed by the program or the user.
On Error Resume Next
If (strMsg = "IE_Quit") Then
blnFlag = False
objIE.Quit
Else
objIE.Document.Body.InnerText = strMsg
If (Err.Number <> 0) Then
Err.Clear
blnFlag = False
Exit Sub
End If
objShell.AppActivate strIETitle
End If
End Sub
Sub InitIE(strMsg)
' Subroutine to initialize the IE display box.
Dim intWidth, intHeight, intWidthW, intHeightW
Set objIE = CreateObject("InternetExplorer.Application")
objIE.ToolBar = False
objIE.StatusBar = False
objIE.Resizable = False
objIE.Navigate("about:blank")
Do Until objIE.readyState = 4
Wscript.Sleep 100
Loop
intWidth = objIE.document.ParentWindow.Screen.AvailWidth
intHeight = objIE.document.ParentWindow.Screen.AvailHeight
intWidthW = objIE.document.ParentWindow.Screen.AvailWidth * .40
intHeightW = objIE.document.ParentWindow.Screen.AvailHeight * .05
objIE.document.ParentWindow.resizeto intWidthW, intHeightW
objIE.document.ParentWindow.moveto (intWidth - intWidthW)/2, (intHeight - intHeightW)/2
objIE.document.Write " " & strMsg & " "
objIE.document.ParentWindow.document.body.style.backgroundcolor = "LightBlue"
objIE.document.ParentWindow.document.body.scroll="no"
objIE.document.ParentWindow.document.body.style.Font = "10pt 'Courier New'"
objIE.document.ParentWindow.document.body.style.borderStyle = "outset"
objIE.document.ParentWindow.document.body.style.borderWidth = "4px"
objIE.document.Title = strIETitle
objIE.Visible = True
Wscript.Sleep 100
objShell.AppActivate strIETitle
End Sub



2. Lösung, anonym


sTitle= "Progress Bar Demo"

nScrW= createobject( _
"htmlfile").parentWindow.screen.availWidth
nScrHt= createobject( _
"htmlfile").parentWindow.screen.availHeight

showBar oIe, sTitle
wscript.sleep 50

oIe.document.parentWindow.document.script.barop 0

do 'your operational loop

' ... (do something)

iPct= iPct +1 'or your increment

on error resume next
oIe.document.parentWindow.document.script.barop iPct

if err then
err.clear
showBar oIe, sTitle
oIe.document.parentWindow.document.script.barop iPct
end if
on error goto 0

loop until (iPct=100)

wscript.sleep 1000
msgbox "Script is complete.", _
vbOkOnly +vbSystemModal, sTitle

oIe.quit
wscript.quit

function showBar (roIe, usTitle)

set roIe= createobject( _
"internetExplorer.application")

roIe.navigate("about:blank")

do
wscript.sleep 50
loop until roIe.readyState=4

with roIe
.fullScreen= true
.toolbar = false
.statusBar = false
.addressBar = false
.resizable= false
.width= 420
.height= 150
.left= (nScrW -420) \2
.top= (nScrHt -150) \2

with .document
.writeLn ("<!doctype html public>")
.writeLn ("<html style=""border-style:outset;" _
& "border-width:4px"" " _
& "onKeyDown=""vbscript:SuppressKeys"" " _
& "onHelp=""vbscript:SuppressIeFns"" " _
& "onContextMenu=""vbscript:SuppressIeFns"">")
.writeLn ("<head>")
.writeLn ("<title>" & usTitle & "</title>")
.writeLn ("<style type=""text/css"">")
.writeLn ("body {background-color:#ece9d8;" _
& "text-align:center;" _
& "vertical-align:middle}")
.writeLn ("</style>")
.writeLn ("<script language=""vbscript"">")
.writeLn ("function SuppressKeys ()")
.writeLn ("select case window.event.keyCode")
.writeLn ("case 112, 114, 116")
.writeLn ("case else: if NOT " _
& "cbool(window.event.ctrlKey) then " _
& "exit function")
.writeLn ("end select")
.writeLn ("window.event.keyCode= 0")
.writeLn ("window.event.cancelBubble= true")
.writeLn ("window.event.returnValue= false")
.writeLn ("end function")
.writeLn ("function SuppressIeFns ()")
.writeLn ("window.event.cancelBubble= true")
.writeLn ("window.event.returnValue= false")
.writeLn ("end function")
.writeLn ("function BarOp (unPct)")
.writeln ("window.bar.style.width= unPct & ""%""")
.writeLn ("end function")
.writeLn ("</script>")
.writeLn ("</head>")
.writeLn ("<body scroll=""no"">")
.writeLn ("<table>")
.writeLn ("<tr>")
.writeLn ("<td style=""text-align:center;" _
& "font-family:Arial;font-size:16pt;" _
& "font-weight:bold"">")
.writeLn ("Progress Bar Demo")
.writeLn ("</td>")
.writeLn ("</tr>")
.writeLn ("<tr>")
.writeLn ("<td id=""barcell"" " _
& "style=""width:400px;" _
& "padding-left:7px;" _
& "padding-right:7px;" _
& "text-align:left;" _
& "border-style:inset;" _
& "border-width:thin;" _
& "background-color:navajowhite"">")
.writeLn ("<hr id=""bar"" " _
& "style=""width:0%;height:15px;" _
& "color:darkblue"" />")
.writeLn ("</td>")
.writeLn ("</tr>")
.writeLn ("<tr>")
.writeLn ("<td style=""padding-top:20px;" _
& "width:400px;font-family:Arial;" _
& "font-size:10pt;" _
& "font-weight:bold"">")
.writeLn ("Loading files ...")
.writeLn ("</td>")
.writeLn ("</tr>")
.writeLn ("</table>")
.writeLn ("</body>")
.writeLn ("</html>")
end with

.visible= true
end with

wscript.sleep 100
createobject("wscript.shell").appActivate _
usTitle
'createobject("autoItX.control").winActivate _
' usTitle, ""

end function




3. Lösung, anonym


sTitle= "Progress Bar Demo"

nDisplayTime= 10
sMsg= "0 seconds elapsed - " _
& (nDisplayTime) & " seconds remaining"
nElapsedTime= 0
nLastTime= 0
nBarElapsedTime= 0
nBarLastTime= 0

nScrW= createobject( _
"htmlfile").parentWindow.screen.availWidth
nScrHt= createobject( _
"htmlfile").parentWindow.screen.availHeight

showBarCounter oIe, sTitle, "0", cstr(nDisplayTime)
wscript.sleep 50

oIe.document.parentWindow.document.script.barop 0
nStartTime= clng(timer)

do 'your operational loop

' ... (do something)

nBarElapsedTime= clng((timer- nStartTime) *100)
nElapsedTime= clng(timer- nStartTime)
nRemainingTime= clng(nDisplayTime- nElapsedTime)

if (nElapsedTime<0) then
nStartTime= nStartTime -(60 *60 *24)
nElapsedTime= clng(timer- nStartTime)
nRemainingTime= clng(nDisplayTime- nElapsedTime)
nBarElapsedTime= clng(timer- nStartTime)
end if

if (nBarElapsedTime>nBarLastTime) then
iPct= cint((nBarElapsedTime /(nDisplayTime *100)) *100)
nBarLastTime= nBarElapsedTime
nLastTime= nElapsedTime

on error resume next
oIe.document.parentWindow.document.script.barop iPct
if (err=0) then _
oIe.document.all.elapsed.innerText= _
cstr(nElapsedTime) & " seconds elapsed"
if (err=0) then _
oIe.document.all.remaining.innerText= _
cstr(nRemainingTime) & " seconds remaining"

if err then
err.clear
showBarCounter oIe, sTitle, cstr(nElapsedTime), _
cstr(nRemainingTime)
oIe.document.parentWindow.document.script.barop iPct
oIe.document.all.msgcell.innerText= sMsg
end if
end if
on error goto 0

loop until (iPct=100)

wscript.sleep 1000
msgbox "Script is complete.", _
vbOkOnly +vbSystemModal, sTitle

oIe.quit
wscript.quit

function showBarCounter (roIe, usTitle, _
usElapsedTime, usRemainingTime)

set roIe= createobject( _
"internetExplorer.application")

roIe.navigate("about:blank")

do
wscript.sleep 50
loop until roIe.readyState=4

with roIe
.fullScreen= true
.toolbar = false
.statusBar = false
.addressBar = false
.resizable= false
.width= 420
.height= 170
.left= (nScrW -420) \2
.top= (nScrHt -170) \2

with .document
.writeLn ("")

.writeLn (" & "border-width:4px"" " _
& "onKeyDown=""vbscript:SuppressKeys"" " _
& "onHelp=""vbscript:SuppressIeFns"" " _
& "onContextMenu=""vbscript:SuppressIeFns"">")
.writeLn ("")
.writeLn ("")
.writeLn ("")
**.writeLn * *("body {background-color:#ece9d8;" _
** * * * * * * & "text-align:center;" _
** * * * * * * & "vertical-align:middle}")
**.writeLn * ("")
.writeLn ("")
**.writeLn * *("function SuppressKeys ()")
**.writeLn * * ("select case window.event.keyCode")
**.writeLn * * *("case 112, 114, 116")
**.writeLn * * *("case else: if NOT " _
** * * * * * * * & "cbool(window.event.ctrlKey) then " _
** * * * * * * * & "exit function")
**.writeLn * * ("end select")
**.writeLn * * ("window.event.keyCode= 0")
**.writeLn * * ("window.event.cancelBubble= true")
**.writeLn * * ("window.event.returnValue= false")
**.writeLn * *("end function")
**.writeLn * *("function SuppressIeFns ()")
**.writeLn * * ("window.event.cancelBubble= true")
**.writeLn * * ("window.event.returnValue= false")
**.writeLn * *("end function")
**.writeLn * *("function BarOp (unPct)")
**.writeln * * ("window.bar.style.width= unPct & ""%""")
**.writeLn * *("end function")
**.writeLn * ("")
.writeLn ("")
.writeLn ("")

.writeLn ("")
.writeLn ("
")
.writeLn ("
& "font-family:Arial;font-size:16pt;" _
& "font-weight:bold"">")
.writeLn ("Progress Bar Demo")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "padding-left:7px;" _
& "padding-right:7px;" _
& "text-align:left;" _
& "border-style:inset;" _
& "border-width:thin;" _
& "background-color:navajowhite"">")
.writeLn (" & "color:darkblue"" />")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "text-align:center;" _
& "font-family:Arial;font-size:12pt;" _
& "font-weight:bold;" _
& "border-style:inset;" _
& "border-width:thin"">")
.writeLn (usElapsedTime & " seconds elapsed")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "text-align:center;" _
& "font-family:Arial;font-size:12pt;" _
& "font-weight:bold;" _
& "border-style:inset;" _
& "border-width:thin"">")
.writeLn (usRemainingTime & " seconds remaining")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "font-family:Arial;" _
& "font-size:10pt;" _
& "font-weight:bold"">")
.writeLn ("Processing ...")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("")
.writeLn ("")
end with

.visible= true
end with

wscript.sleep 100
createobject("wscript.shell").appActivate _
usTitle
'createobject("autoItX.control").winActivate _
' usTitle, ""

end function


4. Möglichkeit, anonym


sTitle= "Progress Bar Demo"

' 40 demo file names
iFiles= 40
sPath= "D:\WINDOWS\system32\"
sFiles= array(, _
"services.exe", _
"activeds.dll", _
"wmpcd.dll", _
"console.dll", _
"autofmt.exe", _
"c_950.nls", _
"comcat.dll", _
"dcache.bin", _
"dmview.ocx", _
"dsuiext.dll", _
"fontview.exe", _
"iccvid.dll", _
"ipxwan.dll", _
"kbdsf.dll", _
"mcdsrv32.dll", _
"modemui.dll", _
"faxpatch.exe", _
"mtxclu.dll", _
"ntmarta.dll", _
"olesvr.dll", _
"pscript.sep", _
"rsh.exe", _
"sfc.exe", _
"mstinit.exe", _
"timedate.cpl", _
"vga.drv", _
"winntbbu.dll", _
"wzcdlg.dll", _
"oddbse32.dll", _
"C_28597.NLS", _
"kbdkyr.dll", _
"wuaueng.dll", _
"sndvol32.exe", _
"VBAEN32.OLB", _
"WindowsLogon.manifest", _
"dx3j.dll", _
"winmm.dll", _
"shsvis.dll", _
"mshtml.dll", _
"itss.dll")

nScrW= createobject( _
"htmlfile").parentWindow.screen.availWidth
nScrHt= createobject( _
"htmlfile").parentWindow.screen.availHeight

showBar oIe, sTitle
wscript.sleep 50

oIe.document.parentWindow.document.script.barop 0

for iFile= 1 to iFiles

' ... (file operation)
wscript.sleep 100 'demo dummy operation only

iPct= cint((iFile /iFiles) *100)
sInsert= sPath & sFiles(iFile) & "
"
sReset= sReset & sInsert

on error resume next
oIe.document.parentWindow.document.script.barop iPct

if (err=0) then _
oIe.document.parentWindow.document.script.listop sInsert

if err then
err.clear
showBar oIe, sTitle
oIe.document.parentWindow.document.script.barop iPct
oIe.document.parentWindow.document.script.listop sReset
end if
on error goto 0

next

wscript.sleep 1000
msgbox "Script is complete.", _
vbOkOnly +vbSystemModal, sTitle

oIe.quit
'wscript.quit

function showBar (roIe, usTitle)

set roIe= createobject( _
"internetExplorer.application")

roIe.navigate("about:blank")

do
wscript.sleep 50
loop until roIe.readyState=4

with roIe
.fullScreen= true
.toolbar = false
.statusBar = false
.addressBar = false
.resizable= false
.width= 420
.height= 270
.left= (nScrW -420) \2
.top= (nScrHt -270) \2

with .document
.writeLn ("")

.writeLn (" & "border-width:4px"" " _
& "onKeyDown=""vbscript:SuppressKeys"" " _
& "onHelp=""vbscript:SuppressIeFns"" " _
& "onContextMenu=""vbscript:SuppressIeFns"">")
.writeLn ("")
.writeLn ("")
.writeLn ("")
**.writeLn * *("body {background-color:#ece9d8;" _
** * * * * * * & "text-align:center;" _
** * * * * * * & "vertical-align:middle}")
**.writeLn * ("")
.writeLn ("")
**.writeLn * *("function SuppressKeys ()")
**.writeLn * * ("select case window.event.keyCode")
**.writeLn * * *("case 112, 114, 116")
**.writeLn * * *("case else: if NOT " _
** * * * * * * * & "cbool(window.event.ctrlKey) then " _
** * * * * * * * & "exit function")
**.writeLn * * ("end select")
**.writeLn * * ("window.event.keyCode= 0")
**.writeLn * * ("window.event.cancelBubble= true")
**.writeLn * * ("window.event.returnValue= false")
**.writeLn * *("end function")
**.writeLn * *("function SuppressIeFns ()")
**.writeLn * * ("window.event.cancelBubble= true")
**.writeLn * * ("window.event.returnValue= false")
**.writeLn * *("end function")
**.writeLn * *("function BarOp (unPct)")
**.writeln * * ("window.bar.style.width= unPct & ""%""")
**.writeLn * *("end function")
**.writeLn * *("function ListOp (usInsert)")
**.writeln * * ("window.insertfile.insertAdjacentHtml " _
** * * * * * * *& """beforeBegin"", usInsert")
**.writeln * * ("window.insertfile.scrollIntoView")
**.writeLn * *("end function")
**.writeLn * ("")
.writeLn ("")
.writeLn ("")

.writeLn ("")
.writeLn ("
")
.writeLn ("
& "font-family:Arial;font-size:16pt;" _
& "font-weight:bold"">")
.writeLn ("Progress Bar Demo")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "padding-left:7px;" _
& "padding-right:7px;" _
& "text-align:left;" _
& "border-style:inset;" _
& "border-width:thin;" _
& "background-color:navajowhite"">")

.writeLn (" & "color:darkblue"" />")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn (" & "max-height:100%;max-width:100%;" _
& "padding-left:10px;text-align:left;" _
& "font-family:Arial;font-size:10pt;" _
& "font-weight:bold;border-style:inset;" _
& "border-width:thin;overflow:scroll"">")
.writeLn ("")
.writeLn ("

")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
& "width:400px;font-family:Arial;" _
& "font-size:10pt;" _
& "font-weight:bold"">")
.writeLn ("Loading files ...")
.writeLn ("
")
.writeLn ("
")
.writeLn ("
")
.writeLn ("")
.writeLn ("")
end with

.visible= true
end with

wscript.sleep 100
createobject("wscript.shell").appActivate _
usTitle
'createobject("autoItX.control").winActivate _
' usTitle, ""

end function