1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
| <html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Open links with IE, Chrome and Firefox and how to pass command line"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Explorer.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<title>Open links with IE, Chrome and Firefox and how to pass command line</title>
<SCRIPT LANGUAGE="VBScript">
'************************************************************************************
Option Explicit
Function Executer(StrCmd,Console)
Dim ws,MyCmd,Resultat
Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
If Console = 0 Then
MyCmd = "CMD /C " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,True)
If Resultat = 0 Then
'MsgBox "Success"
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
'La valeur 1 pour montrer la console MS-DOS
If Console = 1 Then
MyCmd = "CMD /K " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,False)
If Resultat = 0 Then
'MsgBox "Success"
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
Executer = Resultat
End Function
'************************************************************************************
Sub window_onload()
CenterWindow 480,400
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 Ip_Publique()
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public
Titre = "Adresse Ip Publique !"
URL = "http://monip.org"
If OnLine("smtp.gmail.com") = True Then
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=False
DO WHILE ie.busy
Sleep 100
Loop
Data = ie.document.documentElement.innertext
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
MsgBox "Votre IP Publique est : "& Match.Value,64,Titre
Next
ie.Quit
Set ie = Nothing
Else
MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
Exit Sub
End If
End Sub
'**************************************************************************************
Sub Sleep(MSecs)'Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA
Dim fso,objOutputFile
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
Dim tempName : tempName = "Sleeper.vbs"
If Fso.FileExists(tempFolder&"\"&tempName)=False Then
Set objOutputFile = fso.CreateTextFile(tempFolder&"\"&tempName, True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
End Sub
'**************************************************************************************
Sub SSID_names()
Dim objShell,fso,File,strContents,objRegEx,objMatch,colMatches
set objShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If Executer("netsh wlan show all > Wlan.txt",0) = 0 Then
Set File = fso.OpenTextFile("Wlan.txt",1)
strContents = File.ReadAll
Set objRegEx = New RegExp
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Multiline = True
objRegEx.Pattern = """([^""]+)"""
set colMatches = objRegEx.Execute(strContents)
For each objMatch in colMatches
MsgBox "SSID name: " & objMatch.Value,64,"SSID name"
Next
End If
End sub
'***************************************************************************************
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
z = 0
Do
z = z + 1
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
PingStatus = False
Else
PingStatus = True
End If
Next
sleep 200
If z = 4 Then Exit Do
Loop until PingStatus = True
If PingStatus = True Then
OnLine = True
Else
OnLine = False
End If
End Function
'***************************************************************************************
Sub WLAN_Networks()
If Executer("netsh wlan show profiles > Wlan_tmp.txt & netsh wlan show networks >> Wlan_tmp.txt & netsh wlan show interfaces >> Wlan_tmp.txt & cmd /U /C Type Wlan_tmp.txt > Wlan_Networks.txt",0) = 0 Then
Call Executer("Start Wlan_Networks.txt & Del Wlan_tmp.txt",0)
End If
End Sub
</script>
</head>
<p>Links List (examples) :</p>
<ol>
<li><a href="#" onClick="Call Executer('Start iexplore.exe www.google.com',0)">Lien Google avec iexplore.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe http://bbat.lesite.com/',0)">Lien BBAT avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start Firefox.exe www.developpez.net',0)">Lien developpez.net avec Firefox.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.yahoo.fr',0)">Lien Yahoo avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.fr',0)">Lien Autoitscript.fr (Français) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.com',0)">Lien autoitscript.com (Anglais) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start www.sfr.fr',0)">Lien SFR avec votre navigateur by default</a></li>
</ol>
<BODY text=white bgcolor="DarkOrange" TOPMARGIN="1" LEFTMARGIN="1">
<center><button onclick="Call Executer('mode con cols=90 lines=15 & Color 0A & Title Ping sur www.stackoverflow.com by Hackoo & Ping www.stackoverflow.com',1)">Ping on www.stackoverflow.com</button><hr>
<center><button onclick="Call Executer('FindStr /? > HelpFindStrTmp.txt & cmd /U /C Type HelpFindStrTmp.txt > HelpFindStr.txt & start HelpFindStr.txt',0)">Help sur FindStr</button>
<button onclick="Call Executer('ipconfig /all > configTmp.txt & cmd /U /C Type configTmp.txt > MyIPconfig.txt & Del configTmp.txt & start MyIPconfig.txt',0)">IpConfig</button>
<button onclick="Call Executer('mode con cols=80 lines=50 & Color 9B & Title Hackoo & netstat -a',1)">Netstat</button>
<button onclick="Call Executer('mode con cols=60 lines=10 & Color 0A & Title Hackoo & arp -a',1)">Arp</button><hr>
<button onclick="Call Executer('mode con cols=80 lines=30 & Color 9B & Title Tracert vers www.stackoverflow.com by Hackoo & Tracert www.stackoverflow.com',1)">Tracert to stackoverflow</button><br><hr>
<center><button onclick="Call Ip_Publique">IP Publique</button>
<button onclick="Call SSID_names()">SSID WLAN</button>
<button onclick="Call WLAN_Networks()">WLAN Network</button>
</center>
</center>
</body>
</html> |
Exemple de Menu en HTA avec Password et Limite de nombre d'essais
Répondre avec citation
Envoyé par goro_830
) :
, il te manque la fonction 
pourquoi pas, pour remercier, un
Partager