需要密码才能关闭HTA

时间:2015-05-27 18:32:14

标签: vbscript passwords hta locked

我希望有人能证明我的方向。我想设置一个我创建的应用程序启动器,要求关闭密码。感谢您提供的任何帮助。 但是这里有一些不完整的代码可以告诉你我的目的。

Set objShell = CreateObject("Wscript.Shell")
dim password
password=InputBox("Please Enter Password:","3 - Tries Left")
if password = ("9999") then 
    dim correct correct =MsgBox("Correct Password!",64,"correct")
    objShell.Run("shutdown /m shutdown -r -f -t 0")
Else 
    dim again
    again =MsgBox("Incorrect Password! Do You Want To Try Again?",53,"Incorrect Password!")
    If again = 4 Then
        dim password2
        password2=InputBox("Please Enter Password:","2 - Tries Left")
        if password2 = ("9999") then
            dim correct2 
            correct2 =MsgBox("Correct Password!",64,"correct") 

抱歉!我无法发布所有代码。我只需要知道要关闭现有窗口的内容。我想告诉它关闭MSHTA.EXE会起作用。

1 个答案:

答案 0 :(得分:0)

尝试这个HTA,我希望可以做到这一点。

NB:密码 9999 ,当然您可以在此行更改密码 MyGoodPassword = "9999"

<HTML>
<HEAD>
<TITLE></TITLE>
<HTA:APPLICATION
APPLICATIONNAME="Access to the system © Hackoo © 2015"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Explorer.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
</HEAD>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<BODY TOPMARGIN="1" LEFTMARGIN="1"><CENTER><DIV><SPAN ID="ONSCR"></SPAN></DIV></CENTER></BODY>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim Title,ws,Voice,ErrorMsg,WelcomeMsg,MyGoodPassword,Password,Temp,Tests,ProcessEnv,UserName
Title = "Access to the system © Hackoo 2015"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
Set ProcessEnv = Ws.Environment("Process")
UserName = ProcessEnv("USERNAME")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Tests = Temp &"\Tests.txt"
'------------------------------------------------------------------------------------
Sub window_onload()
    CenterWindow 280,180
    Call PasswordForm()
    Call TextFocus
    Dim Count : Count = 0
    If Not objFSO.FileExists(Tests) Then
        Dim Logfile : Set Logfile = objFSO.OpenTextFile(Tests,2,True)
        Logfile.writeline Count
        Logfile.Close
    end If
   Call Kill("Explorer.exe")
   Call DisableTaskMgr()
End Sub
'------------------------------------------------------------------------------------
Sub CenterWindow(x,y)
    Dim iLeft,itop
    window.resizeTo x,y
    iLeft = window.screen.availWidth/2 - x/2
    itop = window.screen.availHeight/2 - y/2
    window.moveTo ileft,itop
End Sub
'------------------------------------------------------------------------------------
Sub PasswordForm()
    Self.document.title = "Access to the system © Hackoo 2015"
    Self.document.bgColor = "DarkOrange"
    ONSCR.InnerHTML="<center><FONT COLOR=""#FFFFFF"" SIZE=""+1"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Type your Password</FONT><br><br><input type=""password"" name=""PasswordArea"" size=""20"" onKeyUp=""TextFocus""><P>"_
    &"<input  type=""Submit"" STYLE=""HEIGHT:25;WIDTH:190"" value=""Access to the system"" name=""run_button""  onClick=""CheckPassword"">"
END Sub
'------------------------------------------------------------------------------------
Sub CheckPassword
    Dim NB_Tests_MAX : NB_Tests_MAX = 3
    Dim Readfile,Count,NB_Tests_Remaining,Logfile,Controle,Command,Executer,MsgNumbTests,MsgReboot
    Set Voice = CreateObject("SAPI.SpVoice")
    ErrorMsg = "ATTENTION ! ! ! "& vbcr &"The Password is Wrong ! "& vbcr &"Try Again !"
    WelcomeMsg = "Welcome again "& DblQuote(UserName) &" in your System !"
    MyGoodPassword = "9999"
    Set Readfile = objFSO.OpenTextFile(Tests,1)
    Count = Readfile.ReadAll
    Readfile.Close
    Controle = True
    While Controle
        Count = Count + 1
        NB_Tests_Remaining = NB_Tests_MAX - Count
        Set Logfile = objFSO.OpenTextFile(Tests,2,True)
        Logfile.writeline Count
        Logfile.Close
        If PasswordArea.Value <> MyGoodPassword Then
            Voice.Speak ErrorMsg
            ws.Popup ErrorMsg,"1",Title,0+16
            MsgNumbTests =  "ATTENTION !!! "&vbcr&"Bad Password and NB°of TESTS is " & Count &"."&vbCr&_
            "The remaining number of tests is "& NB_Tests_Remaining
            Voice.Speak MsgNumbTests
            MsgBox MsgNumbTests,48,Title
            Sleep(1)
            Location.Reload(True)
        end if
        If PasswordArea.Value = MyGoodPassword Then
            If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
            Controle = False
            Voice.Speak WelcomeMsg
            ws.Popup WelcomeMsg,"1",Title,0+64
            Call Launch("Explorer.exe")
            Call EnableTaskMgr()
            Self.Close
            Exit Sub
        End If
        If Count = NB_Tests_MAX Then
            If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
            Voice.Speak "The computer will reboot in 30 seconds !"
            MsgReboot = "The Limit number of tests is reached ! "&vbcr& "The computer will Reboot in 30 seconds !"
                       MsgBox MsgReboot,48,"The Limit number of tests is reached ! "
                       Command="cmd /c Shutdown.exe -r -t 30 -c " & chr(34) & "The computer will reboot in 30 seconds !" & chr(34)
                       Executer = WS.Run(Command,0,False)
                       window.close
        End If
            Exit Sub
        wend
    End Sub
'----------------------------------------------------------------------------------
    Sub TextFocus
        PasswordArea.Focus
    End Sub
'----------------------------------------------------------------------------------
    Sub Kill(Process)
        Dim Ws,Command,Execution
        Set Ws = CreateObject("Wscript.Shell")
        Command = "cmd /c Taskkill /F /IM "&Process&""
        Execution = Ws.Run(Command,0,False)
    End Sub
'----------------------------------------------------------------------------------
    Sub Launch(Process)
        Dim Ws,Command,Execution
        Set Ws = CreateObject("Wscript.Shell")
        Command = "cmd /c Start "&Process&""
        Execution = Ws.Run(Command,0,False)
    End Sub
'-----------------------------------------------------------------------------------
'------------------------------EnableTaskMgr----------------------------------------
    Sub EnableTaskMgr()
        Dim WshShell,System
        System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
        Set WshShell=CreateObject("WScript.Shell")
        Wshshell.RegWrite System, "REG_SZ"
        WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
    End sub
'------------------------------------------------------------------------------------
'-----------------------------DisableTaskMgr-----------------------------------------
    Sub DisableTaskMgr()
        Dim WshShell,System
        System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
        Set WshShell=CreateObject("WScript.Shell")
        Wshshell.RegWrite System, "REG_SZ"
        WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
    End sub
'--------------------------------------------------------------------------------------
    Sub Sleep(intNumSecs)
' Because WScript.Sleep () is not available in HTA
' scripts, invoke a VBScript file to do the waiting.
        Dim strScriptFile, strCommand, intRetcode, objWS
        If intNumSecs <= 0 Then Exit Sub
        Set objWS = CreateObject ("WScript.Shell")
        strScriptFile = "%temp%\wait" & intNumSecs & "seconds.vbs"
        strCommand = "cmd /c ""echo WScript.Sleep " & intNumSecs * 1000 & " >" & strScriptFile & _
        "&start /wait """" wscript.exe " & strScriptFile & """"
        intRetCode = objWS.Run (strCommand, 0, True)
        If intRetCode = 0 Then Exit Sub
    End Sub
'---------------------------------------------------------------------------------------
    Function DblQuote(Str)
             DblQuote = Chr(34) & Str & Chr(34)
    End Function
'---------------------------------------------------------------------------------------
</SCRIPT>