-
Notifications
You must be signed in to change notification settings - Fork 0
/
Wifi_Passwords_Recovery.hta
244 lines (240 loc) · 9.23 KB
/
Wifi_Passwords_Recovery.hta
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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
<html>
<HTA:APPLICATION
ID="oHTA"
APPLICATIONNAME="Wifi Passwords Recovery by Hackoo 2020"
Icon="nslookup.exe"
SCROLL="yes"
BORDER="thin"
INNERBORDER="no"
MAXIMIZEBUTTON="NO"
SINGLEINSTANCE="NO"
SELECTION="NO"
>
<Title>Wifi Passwords Recovery by Hackoo 2020</Title>
<style>
body
{
background-image:url("https://i.gyazo.com/b0f95d232c6aa2dd5b91fa3f1a3a6532.gif");
font-family:font-family :"Comic Sans MS";
color : white;
}
input
{
font-family : "Comic Sans MS";
background-image :url("https://i.gyazo.com/b0f95d232c6aa2dd5b91fa3f1a3a6532.gif");
color : white;
cursor: hand;
}
td {
text-align:center;
}
</style>
<body>
<hr>
<center>
<span id=LoadButton></span>
<hr>
<span id=TableArea></span>
</center>
</body>
</html>
<SCRIPT Language="VBScript">
Option Explicit
Dim Msg,MsgFR,MsgEN,strHTML,CopyRight
CopyRight = chrW(169) & " Hackoo 2020"
window.resizeto 500,10
MsgFR = Array("Récupération des mots de passe Wifi par " & CopyRight,_
"Obtenez tous les SSID avec leurs mots de passe Wifi",_
"Exporter et enregistrer les donnèes dans un fichier CSV")
MsgEN = Array("Wifi Passwords Recovery " & CopyRight,_
"Get All SSID with their Wifi Passwords",_
"Export and Save Data into CSV file")
If Oslang = 1036 Then
Msg = MsgFR ' French Array Message to be set'
Else
Msg = MsgEN ' English Array Message to be set'
End If
Document.title = Msg(0)
strHTML = "<input id=runbutton type='button' value='"& Msg(1)&"' name='run_button' onClick='CreateTable'>"
LoadButton.InnerHTML = strHTML
Play("http://94.23.221.158:9197/stream")
'------------------------------------------------------------------------------------------------------------------------------'
Function CreateTable()
Dim Title,Ws,AppData,Wifi_Folder,fso,f,Data,Delimiter
Dim SSID,KeyPassword,ExportCmd,oFolder,File,Info,i,x,strHTML
Title = "Get All Wifi Passwords by " & chrW(169) & " Hackoo " & Now()
Set Ws = CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
AppData = ws.ExpandEnvironmentStrings("%AppData%")
Wifi_Folder = AppData & "\Wifi"
If Not fso.FolderExists(Wifi_Folder) Then fso.CreateFolder(Wifi_Folder)
ExportCmd = "Cmd /C netsh wlan export profile key=clear folder="& Wifi_Folder &""
ws.run ExportCmd,0,True
Set oFolder = fso.GetFolder(Wifi_Folder)
Delimiter = fGetSeparator
Info = "SSID" & Delimiter & "KeyPassword" & vbCrlf
strHTML = "<center><table width='80%' border><tr bgcolor='DarkOrange'><td width='50%'>SSID</td><td width='50%'>KeyPassword</td></tr>"
For Each File in oFolder.Files
i = i + 1
x = i Mod 2
If UCase(fso.GetExtensionName(File.Name)) = "XML" Then
Set f=fso.opentextfile(File,1)
Data = f.ReadAll
SSID = Extract(Data,"(?:<name>)(.*)(?:<\/name>)")
KeyPassword = Extract(Data,"(?:<keyMaterial>)(.*)(?:<\/keyMaterial>)")
Info = Info & SSID & Delimiter & KeyPassword & vbCrlf
End If
If x = 0 Then
strHTML = strHTML & "<tr>"
Else
strHTML = strHTML & "<tr bgcolor='green'>"
End If
strHTML = strHTML & "<td width='50%'>"& SSID &"</td>"
strHTML = strHTML & "<td width='50%'>"& KeyPassword &"</td>"
strHTML = strHTML & "</tr>"
Next
strHTML = strHTML & "</table><hr>"
strHTML = strHTML & "<input id='SaveButton' type='button' value='"& Msg(2) &"' name='Save' onClick='SaveData'><hr>"
TableArea.InnerHTML = strHTML
CreateTable = Info
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Function Extract(Data,Pattern)
Dim oRE,colMatches,Match,numMatches,myMatch
Dim numSubMatches,subMatchesString,i,j
set oRE = New RegExp
oRE.IgnoreCase = True
oRE.Global = False
oRE.MultiLine = True
oRE.Pattern = Pattern
set colMatches = oRE.Execute(Data)
numMatches = colMatches.count
For i=0 to numMatches-1
'Loop through each match'
Set myMatch = colMatches(i)
numSubMatches = myMatch.submatches.count
'Loop through each submatch in current match'
If numSubMatches > 0 Then
For j=0 to numSubMatches-1
subMatchesString = subMatchesString & myMatch.SubMatches(0)
Next
End If
Next
Extract = subMatchesString
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Function HTAElevate()
Const Elev = " /elevated"
HTAElevate = True
If InStr( LCase( oHTA.commandLine ), Elev) > 0 then Exit Function
On Error Resume Next
window.resizeto 500, 10
'window.moveto screen.width / 2, screen.height / 2 '
On Error GoTo 0
createobject("Shell.Application").ShellExecute "mshta.exe", oHTA.commandLine & Elev, "", "runas", 1
HTAElevate = False
self.close
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Sub Window_Onload
If HTAElevate() = True Then
CenterWindow 700, 500
End If
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 SaveData()
Dim Data,LogFile,HTAPath,CurrentFolder,WS
Set Ws = CreateObject("Wscript.Shell")
HTAPath = Split(Trim_Dequote(oHTA.commandLine),"/")(0)
HTAPath = Replace(HTAPath,chr(34),"")
CurrentFolder = CreateObject("Scripting.FileSystemObject").GetParentFolderName(HTAPath)
LogFile = CurrentFolder & "\Wifi_Passwords.csv"
Data = CreateTable
Call WriteLog(Data,LogFile)
Ws.Run qq(LogFile)
End Sub
'------------------------------------------------------------------------------------------------------------------------------'
Function fGetSeparator()
Dim RegObj,RegKey
Set RegObj = CreateObject("WScript.Shell")
RegKey = RegObj.RegRead("HKEY_CURRENT_USER\Control Panel\International\Slist")
If RegKey = "" Then
MsgBox "There Is no registry value For this key!", vbInformation, "Separator"
Else
fGetSeparator = RegKey
End If
Set RegObj = Nothing
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Sub WriteLog(strText,LogFile)
Dim fs,ts
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'------------------------------------------------------------------------------------------------------------------------------'
Function Trim_Dequote(S)
If Left(S, 1) = """" And Right(S, 1) = """" Then Trim_Dequote = Trim(Mid(S, 2, Len(S) - 2)) Else Trim_Dequote = Trim(S)
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Function OSLang()
Dim dtmConvertedDate,strComputer,objWMIService,oss,os
Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set oss = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each os in oss
OSLang = os.OSLanguage
Next
End Function
'------------------------------------------------------------------------------------------------------------------------------'
Sub Play(URL)
Dim ws,fso,f,TempName,TempFile,TempFolder
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Tempname = fso.GetTempName
TempFolder = WS.ExpandEnvironmentStrings("%Temp%")
TempFile = TempFolder & "\RadioEuroDance90.vbs"
Set f = fso.OpenTextFile(Tempfile,2,True)
f.Writeline "Call Play(" & chr(34) & URL & chr(34) & ")"
f.Writeline "Sub Play(URL)"
f.Writeline "Set Sound = CreateObject(""WMPlayer.OCX"")"
f.Writeline "Sound.URL = URL"
f.Writeline "Sound.settings.volume = 100"
f.Writeline "Sound.Controls.play"
f.Writeline "do while Sound.currentmedia.duration = 0"
f.Writeline "wscript.sleep 100"
f.Writeline "loop"
f.Writeline "wscript.sleep (int(Sound.currentmedia.duration)+1)*1000"
f.Writeline "End Sub"
f.close
ws.run Tempfile
End Sub
'------------------------------------------------------------------------------------------------------------------------------'
Sub Stop_Playing()
Dim Command,ws
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /C Taskkill /IM wscript.exe /F >nul 2>&1"
ws.run Command,0,True
Exit Sub
End Sub
'------------------------------------------------------------------------------------------------------------------------------'
Sub Window_OnUnload()
Call Stop_Playing()
End Sub
'------------------------------------------------------------------------------------------------------------------------------'
Function qq(str)
qq = Chr(34) & str & Chr(34)
End Function
'------------------------------------------------------------------------------------------------------------------------------'
</SCRIPT>