Você não está conectado. Conecte-se ou registre-se
Mensagem [Página 1 de 1]
Botão em HTA Seg Set 09, 2013 11:12 pm Re: Botão em HTA Ter Set 10, 2013 6:19 am
<HTML><HEAD>
<TITLE></TITLE>
<HTA:APPLICATION
APPLICATIONNAME="Exemplo de menu em HTA"
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">
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim WS : Set WS = CreateObject("wscript.shell")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Guarda = Temp &"\Guarda.txt"
Sub window_onload()
CenterWindow 230,130
Call TextFocus
Dim Compteur : Compteur = 0
If Not objFSO.FileExists(Guarda) Then
Dim Logfile : Set Logfile = objFSO.OpenTextFile(Guarda,2,True)
Logfile.writeline Compteur
Logfile.Close
end if
End Sub
Sub CenterWindow(x,y)
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()
Fechar("Explorer.exe")
Self.document.title = "Senha"
Self.document.bgColor = "#BBBFFF"
ONSCR.InnerHTML="<center><FONT COLOR=""#FFFFFF"" SIZE=""+1"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Digite a Senha</FONT<br><input type=""password"" name=""PasswordArea"" size=""20"" onKeyUp=""TextFocus""><P>"_
&"<input type=""Submit"" STYLE=""HEIGHT:25;WIDTH:110"" value=""Acessar Menu"" onClick=""VerifPass"">"
END Sub
Sub VerifPass
Dim NB_Guarda_MAX : NB_Guarda_MAX = 3
Password = "123"
Set Readfile = objFSO.OpenTextFile(Guarda,1)
Compteur = Readfile.ReadAll
Readfile.Close
Controle = True
While Controle
Compteur = Compteur + 1
NB_Guarda_Restant = NB_Guarda_MAX - Compteur
Set Logfile = objFSO.OpenTextFile(Guarda,2,True)
Logfile.writeline Compteur
Logfile.Close
If PasswordArea.Value <> Password Then
MsgBox "Erro de Senha - numero de tentativas - " & Compteur &vbCr&_
"Restante - "& NB_Guarda_Restant,16,"Erro de Senha"
Location.Reload(True)
end if
If PasswordArea.Value = Password Then
MsgBox "Senha Correta !",64,"Senha Correta !"
If objFSO.FileExists(Guarda) Then objFSO.DeleteFile Guarda,True
Controle = False
Call MenuPrincipal()
Call Abrir("Explorer.exe")
Exit Sub
End If
If Compteur = NB_Guarda_MAX Then
If objFSO.FileExists(Guarda) Then objFSO.DeleteFile Guarda,True
MsgBox "Limite de tentativas esgotou ! "&vbcr& "O computador será reiniciado em 90 segundos ",48,"Limite de tentativas atingido"
Command="cmd /c Shutdown.exe -r -t 90 -c " & chr(34) & "Salve seus trabalhos, porque o computador será reiniciado em 90 segundos" & chr(34)
'Executar = WS.Run(Command,0,False)
window.close
End If
Exit Sub
wend
End Sub
Sub TextFocus
PasswordArea.Focus
End Sub
SUB MenuPrincipal()
Self.document.title = "Exemplo de Menu en HTA"
CALL InnerWindowSize(222,587)
ONSCR.InnerHTML="<TABLE HEIGHT=""50"" WIDTH=""220"" BORDER=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"" CELLPADDING=""0"" CELLSPACING=""1"">"_
&"<TR BGCOLOR=""#346E99""><TD COLSPAN=""2""><CENTER><FONT COLOR=""#FFFFFF"" SIZE=""+2"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Menu Principal</FONT></CENTER></TD></TR></TABLE>"_
&"<TABLE WIDTH=""220"" HEIGHT=""184"" BORDER=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"" CELLPADDING=""0"" CELLSPACING=""1"">"_
&"<P><TR><TD><CENTER><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Calculadora"" ONCLICK=""Run(1)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Internet Explorer"" LANGUAGE=""VBScript"" ONCLICK=Run(2)><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Linha de Comando"" LANGUAGE=""VBScript"" ONCLICK=Run(3)><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Meu Computador"" ONCLICK=""Run(4)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Lixeira"" ONCLICK=""Run(5)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Meus Documentos"" ONCLICK=""Run(6)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Arquivos de Programas"" ONCLICK=""Run(7)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Adicionar / Remover Prog."" ONCLICK=""Run(""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Painel de Controle"" ONCLICK=""Run(9)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Propriedades de Video"" ONCLICK=""Run(10)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Bloco de Notas"" ONCLICK=""Run(11)""><P>"_
&"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""WinWord"" ONCLICK=""Run(12)""><P>"_
&"</TD></CENTER></TR></TABLE>"
END SUB
SUB InnerWindowSize(intWidth,intHeight)
Self.ResizeTo intWidth,intHeight
Self.ResizeTo intWidth+(intWidth-Document.Body.OffsetWidth),intHeight+(intHeight-Document.Body.OffsetHeight)
Self.MoveTo (Screen.Width/2)-(intWidth/2),(Screen.Height/2)-(intHeight/2)
END SUB
Sub Run(var)
Set WS = CreateObject("WScript.shell")
Select Case var
Case 1 WS.run("calc.exe")
Case 2 WS.run("iexplore.exe")
Case 3 WS.run("cmd.exe")
Case 4 WS.run("Explorer.exe ::{20d04fe0-3aea-1069-a2d8-08002b30309d}")'Estação de trabalho
Case 5 WS.run "Explorer.exe ::{645FF040-5081-101B-9F08-00AA002F954E}"'Lixeira
Case 6
MyDoc = WS.SpecialFolders("MyDocuments") & "\"
WS.run "Explorer.exe /n,/e,/root,"& MyDoc
Case 7
WS.run "Explorer.exe /n,/e,/root,C:\Program Files"
Case 8
WS.run "CONTROL.EXE APPWIZ.CPL"
Case 9
WS.run "CONTROL.EXE"
Case 10
WS.run "CONTROL.EXE DESK.CPL"
Case 11
WS.run "NOTEPAD.EXE"
Case 12
WS.run "Winword"
End select
End Sub
Sub Fechar(Process)
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
Sub Abrir(Process)
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Start "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
Call PasswordForm()
</SCRIPT>
Re: Botão em HTA Ter Set 10, 2013 8:30 pm Re: Botão em HTA Ter Set 10, 2013 8:33 pm Re: Botão em HTA Qui Set 12, 2013 8:30 pm Mensagem [Página 1 de 1]
Permissões neste sub-fórum
Não podes responder a tópicos
|
|
|
Início