Dynamic Activity Window动态活动窗口vbs
程序员文章站
2022-08-27 15:39:58
复制代码 代码如下:option explicit dim obar set obar = new progressbar obar.startbar "this is a...
复制代码 代码如下:
option explicit
dim obar
set obar = new progressbar
obar.startbar "this is a test."
wscript.sleep (3000)
obar.setline "so is this."
wscript.sleep (3000)
obar.closebar
class progressbar
dim obarcat, sprogressbarhtafile, sprogressbarrunfile, sprogressbarsleepfile, sinitialtempbuild
public sub startbar(smessagetodisplay)
dim sinitialtemp, i
executeglobal "dim oshell, ofso, oenv"
set oshell = createobject("wscript.shell")
set ofso = createobject("scripting.filesystemobject")
set oenv = oshell.environment("process")
for i = 1 to 16
sinitialtempbuild = sinitialtempbuild & chr(frand(97,122))
next
sinitialtemp = ofso.getdrivename(oenv("temp")) & "\" & sinitialtempbuild & "\" & ofso.getfilename(fgettempname)
sprogressbarhtafile = left(sinitialtemp,(len(sinitialtemp)-4)) & ".hta"
sprogressbarrunfile = left(sprogressbarhtafile, len(sprogressbarhtafile)-4) & ".run"
sprogressbarsleepfile = left(sprogressbarhtafile, len(sprogressbarhtafile)-4) & "sleep.vbs"
set obarcat = createobject("scripting.dictionary")
obarcat.add obarcat.count, "<html>"
obarcat.add obarcat.count, "<head>"
obarcat.add obarcat.count, "<title id=" & chr(34) & "title" & chr(34) & ">please wait</title>"
obarcat.add obarcat.count, "<hta:application "
obarcat.add obarcat.count, " id=" & chr(34) & "statusbar" & chr(34) & ""
obarcat.add obarcat.count, " applicationname=" & chr(34) & "statusbar" & chr(34) & ""
obarcat.add obarcat.count, " scroll=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " singleinstance=" & chr(34) & "yes" & chr(34) & ""
obarcat.add obarcat.count, " caption=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " border=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " borderstyle=" & chr(34) & "normal" & chr(34) & ""
obarcat.add obarcat.count, " sysmenu=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " contextmenu=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " showintaskbar=" & chr(34) & "no" & chr(34) & ""
obarcat.add obarcat.count, " />"
obarcat.add obarcat.count, "<script language=" & chr(34) & "vbscript" & chr(34) & ">"
obarcat.add obarcat.count, "dim oshell, itimer1, itimer2, sstatusbarasciitext, spid, icid, sstatusmsg"
obarcat.add obarcat.count, "set oshell = createobject(" & chr(34) & "wscript.shell" & chr(34) & ")"
obarcat.add obarcat.count, "spid = " & chr(34) & "" & chr(34) & ":icid = 10"
obarcat.add obarcat.count, "sub window_onload"
obarcat.add obarcat.count, " window.resizeto 320,250"
obarcat.add obarcat.count, " createobject(" & chr(34) & "scripting.filesystemobject" & chr(34) & ").createtextfile(" & chr(34) & sprogressbarrunfile & chr(34) & ")"
obarcat.add obarcat.count, " createobject(" & chr(34) & "scripting.filesystemobject" & chr(34) & ").createtextfile(" & chr(34) & sprogressbarsleepfile & chr(34) & ")"
obarcat.add obarcat.count, " createobject(" & chr(34) & "scripting.filesystemobject" & chr(34) & ").opentextfile(" & chr(34) & sprogressbarsleepfile & chr(34) & ",2).writeline " & chr(34) & "wscript.sleep(1000)" & chr(34) & ""
obarcat.add obarcat.count, " itimer1 = window.setinterval(" & chr(34) & "do_refresh" & chr(34) & ",175)"
obarcat.add obarcat.count, " itimer2 = window.setinterval(" & chr(34) & "do_nothing" & chr(34) & ",500)"
obarcat.add obarcat.count, "end sub"
obarcat.add obarcat.count, "sub do_nothing"
obarcat.add obarcat.count, " if createobject(" & chr(34) & "scripting.filesystemobject" & chr(34) & ").fileexists(" & chr(34) & sprogressbarrunfile & chr(34) & ") then"
obarcat.add obarcat.count, " dim owmiservice, citems, oitem"
obarcat.add obarcat.count, " set owmiservice = getobject(" & chr(34) & "winmgmts:\\.\root\cimv2" & chr(34) & ")"
obarcat.add obarcat.count, " set citems = owmiservice.execquery(" & chr(34) & "select name, executablepath, commandline from win32_process where name = 'mshta.exe'" & chr(34) & ")"
obarcat.add obarcat.count, " for each oitem in citems"
obarcat.add obarcat.count, " if oitem.commandline = document.location.pathname then"
obarcat.add obarcat.count, " oshell.appactivate oitem.handle"
obarcat.add obarcat.count, " end if"
obarcat.add obarcat.count, " next"
obarcat.add obarcat.count, " else"
obarcat.add obarcat.count, " createobject(" & chr(34) & "scripting.filesystemobject" & chr(34) & ").deletefile " & chr(34) & sprogressbarsleepfile & chr(34) & ", true "
obarcat.add obarcat.count, " window.clearinterval(itimer1)"
obarcat.add obarcat.count, " window.clearinterval(itimer2)"
obarcat.add obarcat.count, " self.close"
obarcat.add obarcat.count, " end if"
obarcat.add obarcat.count, "end sub"
obarcat.add obarcat.count, "sub do_refresh"
obarcat.add obarcat.count, " select case icid"
obarcat.add obarcat.count, " case 10"
obarcat.add obarcat.count, " sstatusbarasciitext =" & chr(34) & "ooooo" & chr(34) & ":icid = 0"
obarcat.add obarcat.count, " case 0"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "oooon" & chr(34) & ":icid = 1"
obarcat.add obarcat.count, " case 1"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "ooono" & chr(34) & ":icid = 2"
obarcat.add obarcat.count, " case 2"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "oonoo" & chr(34) & ":icid = 3"
obarcat.add obarcat.count, " case 3"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "onooo" & chr(34) & ":icid = 4"
obarcat.add obarcat.count, " case 4"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "noooo" & chr(34) & ":icid = 5"
obarcat.add obarcat.count, " case 5"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "onooo" & chr(34) & ":icid = 6"
obarcat.add obarcat.count, " case 6"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "oonoo" & chr(34) & ":icid = 7"
obarcat.add obarcat.count, " case 7"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "ooono" & chr(34) & ":icid = 8"
obarcat.add obarcat.count, " case 8"
obarcat.add obarcat.count, " sstatusbarasciitext = " & chr(34) & "oooon" & chr(34) & ":icid = 1"
obarcat.add obarcat.count, " end select "
obarcat.add obarcat.count, " stats.innerhtml = sstatusbarasciitext"
obarcat.add obarcat.count, " on error resume next"
obarcat.add obarcat.count, " oshell.regread(" & chr(34) & "hklm\system\progressbar\msg" & chr(34) & ")"
obarcat.add obarcat.count, " iregerr = err.number"
obarcat.add obarcat.count, " on error goto 0"
obarcat.add obarcat.count, " if iregerr = 0 then"
obarcat.add obarcat.count, " sstatusmsg = replace(oshell.regread(" & chr(34) & "hklm\system\progressbar\msg" & chr(34) & "), vbcrlf," & chr(34) & "<br>" & chr(34) & ") "
obarcat.add obarcat.count, " else"
obarcat.add obarcat.count, " sstatusmsg = " & chr(34) & "" & chr(34) & ""
obarcat.add obarcat.count, " end if"
obarcat.add obarcat.count, " mymsg.innerhtml = sstatusmsg"
obarcat.add obarcat.count, " end sub"
obarcat.add obarcat.count, "</script>"
obarcat.add obarcat.count, "<style>"
obarcat.add obarcat.count, "body,td,a {font-family:arial;font-size:12px;text-decoration:none;color:black;}"
obarcat.add obarcat.count, "body {filter:progid:dximagetransform.microsoft.gradient(gradienttype=0, startcolorstr='#9999ff', endcolorstr='#ffffff')}"
obarcat.add obarcat.count, ".pix {width: 1px; height 1px;}"
obarcat.add obarcat.count, "</style>"
obarcat.add obarcat.count, "</head>"
obarcat.add obarcat.count, "<body>"
obarcat.add obarcat.count, "<center>"
obarcat.add obarcat.count, "<table width=" & chr(34) & "275" & chr(34) & ">"
obarcat.add obarcat.count, " <tr><td>"
obarcat.add obarcat.count, " <fieldset><legend align=" & chr(34) & "center" & chr(34) & "><b> please be patient </b></legend>"
obarcat.add obarcat.count, " <br><center>"
obarcat.add obarcat.count, " <span id= " & chr(34) & "stats" & chr(34) & " style=" & chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & chr(34) & "></span>"
obarcat.add obarcat.count, " </center><br><br>"
obarcat.add obarcat.count, " </fieldset>"
obarcat.add obarcat.count, " </td></tr>"
obarcat.add obarcat.count, "</table>"
obarcat.add obarcat.count, "<span id= " & chr(34) & "mymsg" & chr(34) & " style=" & chr(34) & "font-family: ariel;font-size:12px;" & chr(34) & "></span>"
obarcat.add obarcat.count, "</body>"
obarcat.add obarcat.count, "</html>"
subwritefile sprogressbarhtafile, join(obarcat.items,vbcrlf)
oshell.regwrite "hklm\system\progressbar\msg", smessagetodisplay, "reg_sz"
oshell.run sprogressbarhtafile, 1, false
end sub
public sub closebar()
fkillfile sprogressbarrunfile
dim sprogressbarhtafilekiller
subkillregkey "hklm\system\progressbar","delete"
sprogressbarhtafilekiller = ofso.getdrivename(oenv("temp")) & "\htakiller.vbs"
subwritefile sprogressbarhtafilekiller, "on error resume next"
subwritefile sprogressbarhtafilekiller, "wscript.sleep(10000)"
subwritefile sprogressbarhtafilekiller, "set ofso = createobject(""scripting.filesystemobject"")"
subwritefile sprogressbarhtafilekiller, "ofso.deletefile " & chr(34) & sprogressbarhtafile & chr(34) & ", true"
subwritefile sprogressbarhtafilekiller, "ofso.deletefolder " & chr(34) & ofso.getdrivename(oenv("temp")) & "\" & sinitialtempbuild & chr(34) & ", true"
subwritefile sprogressbarhtafilekiller, "ofso.deletefile " & chr(34) & sprogressbarhtafilekiller & chr(34) & ", true"
oshell.run "%comspec% /c cscript.exe " & sprogressbarhtafilekiller, 0, false
end sub
public sub setline(snewtext)
oshell.regwrite "hklm\system\progressbar\msg", snewtext, "reg_sz"
end sub
private function fgettempname()
dim ifilenamecharacters, ihighestasciivalue, ilowestasciivalue
dim icharasciivalue, stmpfilename, otempnamedic
set otempnamedic = createobject("scripting.dictionary")
ifilenamecharacters = 8
ihighestasciivalue = 126
ilowestasciivalue = 46
stmpfilename = ""
randomize
do
icharasciivalue = int(((ihighestasciivalue - ilowestasciivalue + 1) * rnd) + ilowestasciivalue)
select case true
case icharasciivalue = 47
case icharasciivalue > 57 and icharasciivalue < 95
case icharasciivalue = 96
case icharasciivalue > 122 and icharasciivalue < 126
case else
otempnamedic.add otempnamedic.count,chr(icharasciivalue)
end select
loop while otempnamedic.count < ifilenamecharacters
fgettempname = oenv("temp") & "\" & join(otempnamedic.items,"") & ".tmp"
otempnamedic.removeall
end function
private function fkillfile(sfiletokill)
dim ierr, serr
select case true
case instr(sfiletokill, "*") <> 0
if ofso.folderexists(ofso.getparentfoldername(sfiletokill)) then
on error resume next
ofso.deletefile sfiletokill, true
ierr = err.number
serr = err.description
on error goto 0
if ierr = 53 then ierr = 0
end if
case ofso.fileexists(sfiletokill)
on error resume next
ofso.deletefile sfiletokill, true
ierr = err.number
serr = err.description
on error goto 0
end select
select case ierr
case 0
fkillfile = 0
case else
fkillfile = serr
end select
end function
private function frand(ilowerlimit,iupperlimit)
executeglobal "dim brandomized"
if brandomized <> true then randomize
brandomized = true
frand = int((iupperlimit - ilowerlimit + 1)*rnd() + ilowerlimit)
end function
private sub subwritefile(sfiletowrite, stexttowrite)
dim ofiletowrite
subcreatefile sfiletowrite
set ofiletowrite = ofso.opentextfile(sfiletowrite,8)
ofiletowrite.writeline stexttowrite
ofiletowrite.close
end sub
private sub subcreatefile(sfiletocreate)
subcreatefolder ofso.getparentfoldername(sfiletocreate)
if not ofso.fileexists(sfiletocreate) then ofso.createtextfile(sfiletocreate)
end sub
private sub subcreatefolder(sfolderpathtocreate)
if trim(sfolderpathtocreate) <> "" then
if ofso.folderexists(sfolderpathtocreate) then
exit sub
else
subcreatefolder(ofso.getparentfoldername(sfolderpathtocreate))
end if
ofso.createfolder(sfolderpathtocreate)
end if
end sub
private sub subkillregkey(byval skeytodelete, sdeleteconfirmation)
dim asubkeys, ssubkey, isubkeycheck, skeytokill, ielement
dim akeypathsubsection, hkeyroot, owmireg, skeyroot
const hkey_classes_root = &h80000000
const hkey_current_user = &h80000001
const hkey_local_machine = &h80000002
const hkey_users = &h80000003
const hkey_current_config = &h80000005
if sdeleteconfirmation <> "delete" then exit sub
akeypathsubsection = split(skeytodelete, "\")
select case ucase(akeypathsubsection(0))
case "hkey_classes_root", "hkcr"
hkeyroot = hkey_classes_root
skeyroot = "hkey_classes_root"
case "hkey_current_user", "hkcu"
hkeyroot = hkey_current_user
skeyroot = "hkey_current_user"
case "hkey_local_machine", "hklm"
hkeyroot = hkey_local_machine
skeyroot = "hkey_local_machine"
case "hkey_users", "hku"
hkeyroot = hkey_users
skeyroot = "hkey_users"
case "hkey_current_config"
hkeyroot = hkey_current_config
skeyroot = "hkey_current_config"
case else
subkillregkey = 1
exit sub
end select
for ielement = 1 to ubound(akeypathsubsection)
skeytokill = skeytokill & "\" & akeypathsubsection(ielement)
next
if left(skeytokill,1) = "\" then skeytokill = right(skeytokill, len(skeytokill)-1)
on error resume next
set owmireg = getobject("winmgmts:{impersonationlevel=impersonate}!\\.\root\default:stdregprov")
isubkeycheck = owmireg.enumkey(hkeyroot, skeytokill, asubkeys)
if isubkeycheck = 0 and isarray(asubkeys) then
for each ssubkey in asubkeys
if err.number <> 0 then
err.clear
exit sub
end if
subkillregkey skeyroot & "\" & skeytokill & "\" & ssubkey, "delete"
next
end if
owmireg.deletekey hkeyroot, skeytokill
end sub
end class
上一篇： VBS访问剪贴板的几种方法小结
下一篇： QWERTY密码：加密与解密vbs版