HTA，VBScript settimeout，更新元素不起作用答案

【问题标题】：HTA, VBScript settimeout, update element not workingHTA，VBScript settimeout，更新元素不起作用
【发布时间】：2021-07-31 13:22:38
【问题描述】：

场景：从正在运行的 HTA 中提取信息，并使用每 1 秒更新一次的信息更新 INPUT 字段。这个概念是在处理数千个文件（如 12300+ 个文件）时将 INPUT 字段用作一种进度条，这样它就不会只是坐在那里近半小时什么都不做！最终结果不会出错，但 INPUT 字段仍为空。

这是我的代码（我知道它“脏”但我只是用于测试）：

<meta http-equiv='X-UA-Compatible' content='IE=8; IE=7' />

<html>
<head>
<hta:application id=oHTA 
border=none 
caption=no 
contextmenu=no 
innerborder=yes 
scroll=no 
showintaskbar=no 
/>

<style> 
body{
  padding: 0;
  margin: 0;
  background-color: #000;
  display: flex;
  align-items: center;
  justify-content: center;
}

img{width:100%;height:100%;left:0;top:0;position:absolute;}
div{z-index:1;position:absolute;color:black;top:80%;width:100%;}
input{width:20%;color:red;background:transparent;}
</style>
</head>


<body style='text-align:center;background:black;'  >
<div>
<button id=click>Click</button><br>
</div>
<input type=text id=myinput />




<script language="vbscript">

mm=self.location.pathname
curdir = split(mm,"\")
for x =0 to ubound(curdir)
settimeout "updater(curdir(x))",10000
next

sub click_onclick
self.close
end sub

function updater(xx)
set ii = document.getelementbyid("myinput")
ii.value=xx
end function
</script>

【问题讨论】：

按原样运行代码将导致“错误：下标超出范围：'x'”。也许您的测试代码中有一个 On Error Resume Next？无论如何， settimeout 会创建一个每 x 毫秒（在您的情况下为 10 秒）运行的事件。将 settimeout 放在 for 循环中是行不通的。考虑异步。您当前的代码试图每 10 秒显示一个级别的路径。那是你要的吗？我不确定这将作为进度表有用。你对每个文件做了什么？也许进度显示可以显示当前正在处理的文件名。
感谢您的反馈。我最终以不同的方式执行此操作，消除了所有错误，并拥有一个功能齐全的 HTA！代码本身很广泛，我几乎没有 cmets 部分中整个内容的字符数量，并且无论如何都不知道如何输入它。再次感谢您的回复。

标签： vbscript hta

【解决方案1】：

正如 LesFerch 所提到的，我最终确实显示了正在处理的文件名以及功能性进度条。在这里输入整个 HTA 内容的代码太多，但这会给您一个不错的主意。整个代码超过 1000 行，因为我包含了一个 Base64 编码的图像。本质上，这是一个重命名 mp3 文件的测试：找到一个条目“，The”或“，A”，删除该条目，将“The”或“A”添加到相应部分的开头，无论它是艺术家还是标题。因为我有超过 14000 个 MP3，我最初编写的代码运行良好，让最终用户（在这种情况下是我！）想知道它是否仍在运行。今天，这个问题得到了解答！代码仍然很丑，我相信它可以消除很多死区，但我很自豪。

    <body style='text-align:center;background:black;'>
    
    <input type=text id="myinput" value=""  />
    <div style="width:100%;top:10px;text-align:center;" id="myDiv2"></div>
    <div id="myDiv" style="font-size:32px;">
    </div>
    <div style="top:10%;left:0;width:100%;"><h2>TheA: The File Fixer</h2></div>
    <button id="myButton" onclick="killvid()" >Close</button>
    <button id="myAbout" onclick="bignews()" style="left:10%;">About</button>
    <button id="myStart" onclick="startproc()" style="left:43%;">Start</button>    
    
    function myTime(xt)
                    set ws = createobject("wscript.shell")
                    xtr=0
                    do until xtr > xt
                    xtr = xtr+1
                    ws.Run "ping 127.0.0.1 -n 1", 0, true
                    loop
        end function
        
        
        
            function updater(xx,yy)
                set ii = document.getelementbyid("myinput")
                if len(ii.value) < 70 then
                ii.value= ii.value & "|"
                else
                ii.value =""
                end if
                myTime(.25)     
            end function

function startproc()
    window.moveto -19999, -19999
    set s = document.getelementsbytagname("BUTTON")
    for each b in s
    b.style.display = "none"
    next
    set  s = nothing
            on error resume next
    
            str = document.location.pathname
            set ws = createobject("wscript.shell") 
            set fs = createobject("scripting.filesystemobject") 
'Open the BrowseForFolder dialog 
        
                Set a2 = sa.BrowseForFolder( 0, "Select Folder",1,&h11&)
                    sp = a2.Self.Path
    window.moveto screen.width / 2 - 900, screen.height /2 - 500
                        if err.number>0 then 
    
                        set mb = document.getelementbyid("myButton")
                        set md = document.getelementbyid("myDiv")
                        md.innertext="Nothing ventured, Nothing gained!" &vbcrlf & "Please exit this window!"
                        mb.style.display="block"
exit function

'more of the function excerpted

if bfn <> dd then
                fs.copyfile file.path, replace(file.path,bfn,dd),1
                rrr = rrr+1
                    if instr(bfn,rr) then
                    fs.deletefile file.path
                md.innertext = "Renaming " & bfn & " to " &vbcrlf & _
                dd & vbcrlf & "Processing " & dtx & " files." & vbcrlf &_
                "Please wait..."
                    elseif instr(bfn,ss) then
                    fs.deletefile file.path
                dtx = dtx-1
                md.innertext = "Renaming " & bfn & " to " &vbcrlf & _
                dd & vbcrlf & "Processing " & dtx & " files." & vbcrlf &_
                "Please wait..."
                    END IF

                updater bfn,dd  
                end if
end function

【讨论】：

听起来很有趣。也许把它发布在 GitHub 上？
我也得研究一下。 14 年的大部分时间里，我一直在编写 vbscript，但它只供个人使用。所有这些论坛对我来说都是新的。我在 W3C 上完成了所有的学习，直到他们删除了几乎所有关于 VBScript 的内容。我听说它已被弃用和暂停，但它太容易配置并且非常容易编写。这里有一些关于老狗的格言……但无论如何。我将研究 Git Hub。非常感谢。
酷。如果你想给我发一份反馈/精简，你可以在 GitHub 上找到我的联系信息。