hackoo

Wifi Passwords Recovery.vbs

Sep 22nd, 2020 (edited)
1,635
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2. REM ' New Version in HTA ==> https://pastebin.com/DnvhmT72
  3. Call RunAsAdmin()
  4. Dim Title,Ws,AppData,Wifi_Folder,fso,f,Data
  5. Dim SSID,KeyPassword,ExportCmd,oFolder,File,Info,LogFile
  6. LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
  7. Title = "Wifi Passwords Recovery by " & chrW(169) & " Hackoo " & Now()
  8. Set Ws = CreateObject("Wscript.Shell")
  9. Set fso = CreateObject("Scripting.FileSystemObject")
  10. AppData = ws.ExpandEnvironmentStrings("%AppData%")
  11. Wifi_Folder = AppData & "\Wifi"
  12. If Not fso.FolderExists(Wifi_Folder) Then fso.CreateFolder(Wifi_Folder)
  13. ExportCmd = "Cmd /C netsh wlan export profile key=clear folder="& Wifi_Folder &""
  14. ws.run ExportCmd,0,True
  15. Set oFolder = fso.GetFolder(Wifi_Folder)
  16. Info = String(40,"-") & vbCrlf & Space(4) &_
  17. "SSID" & Space(4) &":"& Space(4) & "KeyPassword" & vbCrlf &_
  18. String(40,"-") & vbCrlf
  19. For Each File in oFolder.Files
  20.     If UCase(fso.GetExtensionName(File.Name)) = "XML" Then
  21.         Set f=fso.opentextfile(File,1)
  22.         Data = f.ReadAll
  23.         SSID = Extract(Data,"(?:<name>)(.*)(?:<\/name>)")
  24.         KeyPassword = Extract(Data,"(?:<keyMaterial>)(.*)(?:<\/keyMaterial>)")
  25.         Info = Info & qq(SSID) & ":" & qq(KeyPassword) & vbCrlf
  26.     End If
  27. Next
  28. MsgBox Info,vbInformation,Title
  29. Call WriteLog(Info,LogFile)
  30. If fso.FileExists(LogFile) Then ws.run qq(LogFile)
  31. '---------------------------------------------------------------------------------------------
  32. Function Extract(Data,Pattern)
  33.     Dim oRE,colMatches,Match,numMatches,myMatch
  34.     Dim numSubMatches,subMatchesString,i,j
  35.     set oRE = New RegExp
  36.     oRE.IgnoreCase = True
  37.     oRE.Global = False
  38.     oRE.MultiLine = True
  39.     oRE.Pattern = Pattern
  40.     set colMatches = oRE.Execute(Data)
  41.     numMatches = colMatches.count
  42.     For i=0 to numMatches-1  
  43. 'Loop through each match
  44.         Set myMatch = colMatches(i)
  45.         numSubMatches = myMatch.submatches.count
  46. 'Loop through each submatch in current match
  47.         If numSubMatches > 0 Then    
  48.             For j=0 to numSubMatches-1
  49.                 subMatchesString = subMatchesString & myMatch.SubMatches(0)
  50.             Next
  51.         End If
  52.     Next
  53.     Extract = subMatchesString
  54. End Function
  55. '---------------------------------------------------------------------------------------------
  56. Sub RunAsAdmin()
  57.     If Not WScript.Arguments.Named.Exists("elevate") Then
  58.         CreateObject("Shell.Application").ShellExecute WScript.FullName _
  59.         , chr(34) & WScript.ScriptFullName & chr(34) & " /elevate", "", "runas", 1
  60.         WScript.Quit
  61.     End If
  62. End Sub
  63. '---------------------------------------------------------------------------------------------
  64. Function qq(str)
  65.     qq = Chr(34) & str & Chr(34)
  66. End Function
  67. '---------------------------------------------------------------------------------------------
  68. Sub WriteLog(strText,LogFile)
  69.     Dim fs,ts
  70.     Const ForWriting = 2
  71.     Set fs = CreateObject("Scripting.FileSystemObject")
  72.     Set ts = fs.OpenTextFile(LogFile,ForWriting,True)
  73.     ts.WriteLine strText
  74.     ts.Close
  75. End Sub
  76. '---------------------------------------------------------------------------------------------
RAW Paste Data