保持一個VBScript窗口頂部，以及添加一個註銷按鈕

我有一段腳本，用戶Hackoo的courtosey，但有兩件事是錯誤的。首先，窗口需要保持在最前面，它不應該能夠從任務欄退出，它需要位於屏幕的右下角（位於任務欄上方），並且它需要在其下面有一個按鈕說「註銷」的文字。當然，註銷按鈕需要註銷計算機。下面的代碼：保持一個VBScript窗口頂部，以及添加一個註銷按鈕

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

感謝，馬修

來源

2015-04-13 Matthew Taylor

請注意，我不認爲我們可以呆在總是在頂部，但無論如何，只要給這一修改的一個嘗試，現在你希望它在右側不在左邊，我添加了按鈕以退出會話：

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

來源

2015-04-13 00:51:28 Hackoo

謝謝！這很棒。我希望其他人會覺得這很有用。 –

保持一個VBScript窗口頂部，以及添加一個註銷按鈕

回答

相關問題