标题: [HTA]为何window.setInterval用法不成功(VBS脚本延迟) [打印本页]
作者: kich 时间: 2007-11-7 21:34 标题: [HTA]为何window.setInterval用法不成功(VBS脚本延迟)
目的:
扫描当前目录及子目录下文件,并显示在HTA的SPAN区域,如果文件后缀是bak则删除这个文件,并显示在删除区域,因为要实时显示,所以要用暂停保证SPAN区域显示了,才进行下步代码.但HTA里没有wscript.sleep 1000 这样的代码,所以使用setInterval
但却不成功
PS:不想使用借用VBS或者CMD实现暂停,因为占内存,并且鼠标一直显示忙碌状态,个人觉得不专业.
以下是代码:
<html><title>HTA template</title><head>
<HTA:APPLICATION
APPLICATIONNAME="HTA Template"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 0px;`
margin-left: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}
#scroll
{
height:100%;
overflow:auto;
}
SELECT.FixedWidth
{
width: 17em; /* maybe use px for pixels or pt for points here */
}
</style>
<script language="VBScript">
Public fso
Dim iTimerID
Set fso=CreateObject("Scripting.FileSystemObject")
Sub ButtonClick
curPath=Mid(fso.GetParentFolderName(window.location),9)
seek curpath
End Sub
Sub seek(Path)
'Set fso=CreateObject("Scripting.FileSystemObject")
Set curF=fso.GetFolder(path)
If curF.SubFolders.count>0 Then
For Each subf In curF.SubFolders
seek subf
Next
End If
If curF.Files.count>0 Then
For Each file In curF.Files
scaning.innertext=file
iTimerID = window.setInterval("DF(file)",1000)
Next
End If
End Sub
Sub DF(files)
window.clearInterval(iTimerID)
If lcase(fso.GetExtensionName(files))="bak" Then
MsgBox files
done.innertext=done.innertext&vbCr&files
fso.DeleteFile files
End If
End Sub
Sub window_onload
window.resizeTo 700,400
End Sub
</script>
<body >
<p> 点击＂查杀＂按钮进行查杀：
<input class="button" type=BUTTON value="查杀" name="btnTestButton" onClick="ButtonClick">
</p>
<p> 当前正在查杀：<br>
<font color="#00FF00"><span id="scaning" class="FixedWidth" >请点击“查杀”按钮 </span>
</p>
</font></p>
<p> 被删除的文件:<br> </p> <font color="#00FF00"> <span id="done" class="FixedWidth" > </span></font>
</p>
<p> </p>
<P align="right">
</body></html>
<HTA:APPLICATION
APPLICATIONNAME="HTA Template"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 0px;`
margin-left: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}
#scroll
{
height:100%;
overflow:auto;
}
SELECT.FixedWidth
{
width: 17em; /* maybe use px for pixels or pt for points here */
}
</style>
<script language="VBScript">
Public fso
Dim iTimerID
Set fso=CreateObject("Scripting.FileSystemObject")
Sub ButtonClick
curPath=Mid(fso.GetParentFolderName(window.location),9)
seek curpath
End Sub
Sub seek(Path)
'Set fso=CreateObject("Scripting.FileSystemObject")
Set curF=fso.GetFolder(path)
If curF.SubFolders.count>0 Then
For Each subf In curF.SubFolders
seek subf
Next
End If
If curF.Files.count>0 Then
For Each file In curF.Files
scaning.innertext=file
iTimerID = window.setInterval("DF(file)",1000)
Next
End If
End Sub
Sub DF(files)
window.clearInterval(iTimerID)
If lcase(fso.GetExtensionName(files))="bak" Then
MsgBox files
done.innertext=done.innertext&vbCr&files
fso.DeleteFile files
End If
End Sub
Sub window_onload
window.resizeTo 700,400
End Sub
</script>
<body >
<p> 点击＂查杀＂按钮进行查杀：
<input class="button" type=BUTTON value="查杀" name="btnTestButton" onClick="ButtonClick">
</p>
<p> 当前正在查杀：<br>
<font color="#00FF00"><span id="scaning" class="FixedWidth" >请点击“查杀”按钮 </span>
</p>
</font></p>
<p> 被删除的文件:<br> </p> <font color="#00FF00"> <span id="done" class="FixedWidth" > </span></font>
</p>
<p> </p>
<P align="right">
</body></html>
作者: zh159 时间: 2007-11-7 23:15
setTimeout、setInterval只适用于延时执行指定的命令，并不能在自身循环内延时
作者: abcd 时间: 2007-11-8 09:26
<html><title>HTA template</title><head>
<HTA:APPLICATION
APPLICATIONNAME="HTA Template"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 0px;`
margin-left: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}
#scroll
{
height:100%;
overflow:scroll;
}
SELECT.FixedWidth
{
width: 17em; /* maybe use px for pixels or pt for points here */
}
</style>
<script language="VBScript">
Public fso
Dim iTimerID
Set fso=CreateObject("Scripting.FileSystemObject")
Sub ButtonClick
curPath=Replace(Mid(fso.GetParentFolderName(window.location),9),"%20"," ")
if document.getElementsByName("btnTestButton").item(0).value="查杀" then
iTimerID = window.setInterval("seek('" + curPath + "')",2000)
document.getElementsByName("btnTestButton").item(0).value="停止"
else
window.clearInterval(iTimerID)
document.getElementsByName("btnTestButton").item(0).value="查杀"
end if
End Sub
Sub seek(Path)
'Set fso=CreateObject("Scripting.FileSystemObject")
scaning.innertext=""
Set curF=fso.GetFolder(path)
If curF.SubFolders.count>0 Then
For Each subf In curF.SubFolders
seek subf
Next
End If
If curF.Files.count>0 Then
For Each file In curF.Files
scaning.innertext=scaning.innertext&vbCr&file
DF file
Next
End If
End Sub
Sub DF(files)
'window.clearInterval(iTimerID)
If lcase(fso.GetExtensionName(files))="bak" Then
MsgBox files
done.innertext=done.innertext&vbCr&files
fso.DeleteFile files
End If
End Sub
Sub window_onload
window.resizeTo 700,400
End Sub
</script>
<body >
<p> 点击＂查杀＂按钮进行查杀：
<input class="button" type=BUTTON value="查杀" name="btnTestButton" onClick="ButtonClick">
</p>
<p> 当前正在查杀：<br>
<font color="#000000"><span id="scaning" class="FixedWidth" >请点击“查杀”按钮 </span>
</p>
</font></p>
<p> 被删除的文件:<br> </p> <font color="#FF0000"> <span id="done" class="FixedWidth" > </span></font>
</p>
<p> </p>
<P align="right">
</body></html>
有个问题，路径的中的空格问题，会被转成有效的统一资源标识符，全部替换吧<HTA:APPLICATION
APPLICATIONNAME="HTA Template"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 0px;`
margin-left: 0px;
margin-right: 0px;
margin-bottom: 0px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}
#scroll
{
height:100%;
overflow:scroll;
}
SELECT.FixedWidth
{
width: 17em; /* maybe use px for pixels or pt for points here */
}
</style>
<script language="VBScript">
Public fso
Dim iTimerID
Set fso=CreateObject("Scripting.FileSystemObject")
Sub ButtonClick
curPath=Replace(Mid(fso.GetParentFolderName(window.location),9),"%20"," ")
if document.getElementsByName("btnTestButton").item(0).value="查杀" then
iTimerID = window.setInterval("seek('" + curPath + "')",2000)
document.getElementsByName("btnTestButton").item(0).value="停止"
else
window.clearInterval(iTimerID)
document.getElementsByName("btnTestButton").item(0).value="查杀"
end if
End Sub
Sub seek(Path)
'Set fso=CreateObject("Scripting.FileSystemObject")
scaning.innertext=""
Set curF=fso.GetFolder(path)
If curF.SubFolders.count>0 Then
For Each subf In curF.SubFolders
seek subf
Next
End If
If curF.Files.count>0 Then
For Each file In curF.Files
scaning.innertext=scaning.innertext&vbCr&file
DF file
Next
End If
End Sub
Sub DF(files)
'window.clearInterval(iTimerID)
If lcase(fso.GetExtensionName(files))="bak" Then
MsgBox files
done.innertext=done.innertext&vbCr&files
fso.DeleteFile files
End If
End Sub
Sub window_onload
window.resizeTo 700,400
End Sub
</script>
<body >
<p> 点击＂查杀＂按钮进行查杀：
<input class="button" type=BUTTON value="查杀" name="btnTestButton" onClick="ButtonClick">
</p>
<p> 当前正在查杀：<br>
<font color="#000000"><span id="scaning" class="FixedWidth" >请点击“查杀”按钮 </span>
</p>
</font></p>
<p> 被删除的文件:<br> </p> <font color="#FF0000"> <span id="done" class="FixedWidth" > </span></font>
</p>
<p> </p>
<P align="right">
</body></html>
又怕某些文件夹名中有“%20”字符，不转的话，又会找不到路径
vbs中，又没js中的decodeURI方法。
[ Last edited by abcd on 2007-11-8 at 10:16 AM ]
作者: kich 时间: 2007-11-8 11:33
首先感谢楼上的,测试了下,感觉不是很好~~!
因为不能实时显示当前正在查杀的文件,呈现扫描状态,一直都在更新,都在动.
希望能有这样的脚本.
PS:因为是递归程序,所以用SETINTERVAL有点困难,期待.