Question

我有一个脚本，由用户Hackoo提起诉讼，但有两件事是错的。首先，窗口需要保持在顶部，它不能从任务栏退出，它需要位于屏幕的右下角（任务栏上方），它需要有一个按钮它低于文字说＆＃34;注销＆＃34;。当然，注销按钮需要注销计算机。这是代码：

Option Explicit
Dim Title,ws,nMinutes,nSeconds,sMessage
Title = "Session Timer"
Set ws = CreateObject("wscript.Shell")
nMinutes = 20
nSeconds = 0
sMessage = "<font color=Red size=2><b>You have"
'Open a chromeless window with message
with HTABox("lightBlue",100,250,0,630)
.document.title = "Session Timer"
.msg.innerHTML = sMessage
do until .done.value or (nMinutes + nSeconds < 1)
    .msg.innerHTML = sMessage & "<br>" & nMinutes & ":" &   Right("0"&nSeconds, 2) _
    & " minutes of session time remaining</b></font><br>"
    wsh.sleep 1000 ' milliseconds
    nSeconds = nSeconds - 1
    if nSeconds < 0 then 
        if nMinutes > 0 then
            nMinutes = nMinutes - 1
            nSeconds = 59
        end if
    end if
loop
.done.value = true
.close
end with
ws.Popup "Your session time has finished. You will now be logged         off.","5",Title,0+48
'*****************************************************************
Function HTABox(sBgColor, h, w, l, t)
Dim IE, HTA, sCmd, nRnd
randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo(" & w & "," & h & ");" _
& "window.moveTo(" & l & "," & t & ")}"""
with CreateObject("WScript.Shell")
    .Run sCmd, 1, False
    do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
    end with  'WSHShell
    For Each IE In CreateObject("Shell.Application").windows
        If IsObject(IE.GetProperty(nRnd)) Then
            set HTABox = IE.GetProperty(nRnd)
            IE.Quit
            HTABox.document.title = "HTABox"
            HTABox.document.write _
            "<HTA:Application contextMenu=no border=thin " _
            & "minimizebutton=no maximizebutton=no sysmenu=no             SHOWINTASKBAR=no >" _
            & "<body scroll=no style='background-color:" _
            & sBgColor & ";font:normal 10pt Arial;" _
            & "border-Style:inset;border-Width:3px'" _
            & "onbeforeunload='vbscript:if not done.value then " _
            & "window.event.cancelBubble=true:" _
            & "window.event.returnValue=false:" _
            & "done.value=true:end if'>" _
            & "<input type=hidden id=done value=false>" _
            & "<center><span id=msg>&nbsp;</span><br>" _
            & "<input type=button id=btn1 value=' OK ' "_
            & "onclick=done.value=true><center></body>"
            HTABox.btn1.focus
            Exit Function
        End If
    Next
    MsgBox "HTA window not found."
    wsh.quit
End Function

谢谢，马修

Answer 1

请注意，我不认为我们可以始终保持在最顶层，但无论如何只是尝试进行此修改，现在你想要它在右边的角落而不是左边，我将按钮添加到Logoff会议：

Option Explicit
Dim Title,ws,nMinutes,nSeconds,sMessage,Command,Executer
Title = "Session Timer"
Set ws = CreateObject("wscript.Shell")
nMinutes = 20
nSeconds = 0
sMessage = "<font color=Red size=2><b>You have"
'Open a chromeless window with message
with HTABox("lightBlue",130,300,1070,600)
.document.title = "Session Timer"
.msg.innerHTML = sMessage
do until .done.value or (nMinutes + nSeconds < 1)
    .msg.innerHTML = sMessage & "<br>" & nMinutes & ":" &   Right("0"&nSeconds, 2) _
    & " minutes of session time remaining</b></font><br>"
    wsh.sleep 1000 ' milliseconds
    nSeconds = nSeconds - 1
    if nSeconds < 0 then 
        if nMinutes > 0 then
            nMinutes = nMinutes - 1
            nSeconds = 59
        end if
    end if
loop
.done.value = true
.close
end with
ws.Popup "Your session time has finished. You will now be logged off.","5",Title,0+48
Command ="cmd /c Shutdown.exe -l -f"
Executer = WS.Run(Command,0,False) 
'*****************************************************************
Function HTABox(sBgColor,h, w, l, t)
Dim IE, HTA, sCmd, nRnd
randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo(" & w & "," & h & ");" _
& "window.moveTo(" & l & "," & t & ")}"""
with CreateObject("WScript.Shell")
    .Run sCmd, 1, False
    do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
    end with  'WSHShell
    For Each IE In CreateObject("Shell.Application").windows
        If IsObject(IE.GetProperty(nRnd)) Then
            set HTABox = IE.GetProperty(nRnd)
            IE.Quit
            HTABox.document.title = "HTABox"
            HTABox.document.write _
            "<HTA:Application contextMenu=no border=thin " _
            & "minimizebutton=no maximizebutton=no sysmenu=no SHOWINTASKBAR=no >" _
            & "<body scroll=no style='background-color:" _
            & sBgColor & ";font:normal 10pt Arial;" _
            & "border-Style:inset;border-Width:3px'" _
            & "onbeforeunload='vbscript:if not done.value then " _
            & "window.event.cancelBubble=true:" _
            & "window.event.returnValue=false:" _
            & "done.value=true:end if'>" _
            & "<input type=hidden id=done value=false>" _
            & "<center><span id=msg>&nbsp;</span><br>" _
            & "<input type=button id=btn1 value=' Log Off ' "_
            & "onclick=done.value=true><center></body>"
            HTABox.btn1.focus
            Exit Function
        End If
    Next
    MsgBox "HTA window not found."
    wsh.quit
End Function

保持VBScript窗口在顶部，以及添加注销按钮

1 个答案: