hackoo

Check_Internet_Connection.hta

Aug 26th, 2020 (edited)
920
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. <html>
  2. <head>
  3. <title>Network Diagnostics And Checking Internet Connection by Hackoo 2020</title>
  4. <HTA:APPLICATION
  5.  Application ID = "Check_Internet_Connection"
  6.  APPLICATIONNAME = "Check_Internet_Connection"
  7.  BORDER="THIN"
  8.  BORDERSTYLE="NORMAL"
  9.  CAPTION = "Yes"
  10.  CONTEXTMENU = "Yes"
  11.  ICON = "nslookup.exe"
  12.  INNERBORDER="NO"
  13.  MAXIMIZEBUTTON="NO"
  14.  MINIMIZEBUTTON="YES"
  15.  SCROLL="NO"
  16.  SELECTION="NO"
  17.  SHOWINTASKBAR = "Yes"
  18.  SINGLEINSTANCE = "Yes"
  19.  SYSMENU = "Yes"
  20. />
  21. <style type="text/css">
  22.   body {
  23.         font-family:Verdana;
  24.         font-size: 10x;
  25.         color: #49403B;
  26.         background: LightGreen;
  27.         }
  28.  </style>
  29. </head>
  30. <body>
  31.     <center>
  32.         <span id="DataArea">Please Wait a while ... Loading is in Progress ...</span>
  33.         </br></br>
  34.         <span id="WAN_IP">Please Wait a while ... Loading is in Progress ...</span>
  35.     </center>
  36. </body>
  37. </html>
  38.  
  39. <SCRIPT LANGUAGE="VBScript" defer="True">
  40. Option Explicit
  41. Dim Msg_Connected,Msg_NOT_Connected,Msg,MsgFR,MsgEN,CopyRight
  42. CopyRight = ChrW(169) & " 2020 by Hackoo "
  43.  
  44. MsgEN = Array(_
  45. "Network Diagnostics And Checking Internet Connection ",_
  46. "Connection Status : Connected To The Internet",_
  47. "Not Connected to the Internet ... We are trying to establish again your connection"_
  48. )
  49.  
  50. MsgFR = Array(_
  51. "Diagnostics Réseau et Vérification de la connexion Internet ",_
  52. "Etat de la connexion : Vous êtes connecté à Internet",_
  53. "Non connecté à Internet ... Nous essayons de rétablir votre connexion"_
  54. )
  55.  
  56. If Oslang = 1036 Then
  57.     Msg = MsgFR ' French Array Message to be set
  58. Else
  59.     Msg = MsgEN ' English Array Message to be set
  60. End If
  61.  
  62. Msg_Connected = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
  63.         "<h2><font color=""GREEN""><strong>"& Msg(1) & "<strong></font></h2></Marquee><br><br>"&_
  64.         "<img src=""https://cdn2.unrealengine.com/Fortnite%2FBoogieDown_GIF-1f2be97208316867da7d3cf5217c2486da3c2fe6.gif""></img>"
  65.        
  66. Msg_NOT_Connected = "<Marquee DIRECTION=""Right"" SCROLLAMOUNT=""6"" BEHAVIOR=""ALTERNATE"">"&_
  67.         "<h3><font color=""RED""><strong>"& Msg(2) & "<strong></font></h3></Marquee>"
  68. '--------------------------------------------------------------------------------------
  69. Sub CenterWindow( widthX, heightY )
  70.     self.ResizeTo widthX, heightY
  71.     self.MoveTo (screen.Width - widthX)/2, (screen.Height - heightY)/2
  72. End Sub
  73. '--------------------------------------------------------------------------------------
  74. Sub Get_Date_Time()
  75.     Document.Title = Msg(0) & CopyRight & Now
  76. End Sub
  77. '--------------------------------------------------------------------------------------
  78. Sub Window_OnLoad()
  79.     CenterWindow 800,600
  80.     Call Shortcut()
  81.     Call CheckUP()
  82.     SetInterval "Get_Date_Time",1000
  83.     If Get_WAN_IP <> "" Then SayIt()
  84.     ' Nous revérifions la connexion toutes les minutes
  85.     ' We re-check connection every minute
  86.     SetInterval "CheckUP()",60000
  87. End Sub
  88. '--------------------------------------------------------------------------------------
  89. Sub CheckUP()
  90. Dim MyLoop,strComputer,objPing,objStatus,ws
  91. Set ws = CreateObject("wscript.shell")
  92. Call Get_Date_Time
  93. MyLoop = True
  94. While MyLoop
  95.     strComputer = "smtp.gmail.com"
  96.     Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
  97.     ("select * from Win32_PingStatus where address = '" & strComputer & "'")
  98.     For Each objStatus in objPing
  99.         If objStatus.Statuscode = 0 Then
  100.             MyLoop = False
  101.             DataArea.InnerHTML = Msg_Connected
  102.             WAN_IP.InnerHTML = "<h2><font color=""GREEN""><strong> WAN IP : " & Get_WAN_IP & "<strong></font></h2>"
  103.             Exit for
  104.         Else
  105.             DataArea.InnerHTML = Msg_NOT_Connected
  106.             WAN_IP.InnerHTML = ""
  107.             ws.run "%SystemRoot%\system32\msdt.exe -skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI"
  108.         End If
  109.     Next
  110.     Sleep(10) 'To sleep for 10 secondes
  111. Wend
  112. End Sub
  113. '--------------------------------------------------------------------------------------
  114. Sub Sleep(seconds)
  115.     CreateObject("WScript.Shell").Run "CMD /c ping 127.0.0.1 -n " & seconds,0,True
  116. End Sub
  117. '--------------------------------------------------------------------------------------
  118. Function Get_WAN_IP()
  119. Dim http
  120. Set http = CreateObject("Microsoft.XMLHTTP" )
  121. http.Open "GET", "https://ifconfig.me/ip", False
  122. http.Send
  123. Get_WAN_IP= http.responseText  
  124. End Function
  125. '--------------------------------------------------------------------------------------
  126. Sub SayIt()
  127. Dim fso,WaveFile,ws
  128. Set ws = CreateObject("wscript.Shell")
  129. Set fso = CreateObject("Scripting.FileSystemObject")
  130. WaveFile = WS.ExpandEnvironmentStrings("%LocalAppData%\Microsoft\Windows Sidebar\Gadgets\NetworkMonitorII.gadget\media\established.wav")
  131. If fso.FileExists(WaveFile) Then
  132.     Play(WaveFile)
  133.     Sleep(5)
  134.     Play("http://94.23.221.158:9197/stream")
  135. Else
  136.     CreateObject("SAPI.SpVoice").Speak "You are Connected to the internet"
  137.     Sleep(5)
  138.     Play("http://94.23.221.158:9197/stream")
  139. End If
  140. End Sub
  141. '--------------------------------------------------------------------------------------
  142. Sub Play(URL)
  143.     Dim ws,fso,f,TempName,TempFile,TempFolder
  144.     Set ws = CreateObject("wscript.Shell")
  145.     Set fso = CreateObject("Scripting.FileSystemObject")
  146.     Tempname = fso.GetTempName
  147.     TempFolder = WS.ExpandEnvironmentStrings("%Temp%")
  148.     TempFile = TempFolder & "\RadioEuroDance90.vbs"
  149.     Set f = fso.OpenTextFile(Tempfile,2,True)
  150.     f.Writeline     "Call Play(" & chr(34) & URL & chr(34) & ")"
  151.     f.Writeline "Sub Play(URL)"
  152.     f.Writeline "Set Sound = CreateObject(""WMPlayer.OCX"")"
  153.     f.Writeline "Sound.URL = URL"
  154.     f.Writeline "Sound.settings.volume = 100"                              
  155.     f.Writeline "Sound.Controls.play"                                    
  156.     f.Writeline "do while Sound.currentmedia.duration = 0"                
  157.     f.Writeline     "wscript.sleep 100"                                      
  158.     f.Writeline "loop"                                                    
  159.     f.Writeline "wscript.sleep (int(Sound.currentmedia.duration)+1)*1000"
  160.     f.Writeline "End Sub"
  161.     f.close
  162.     ws.run Tempfile
  163. End Sub
  164. '--------------------------------------------------------------------------------------
  165. Sub Stop_Playing()
  166.     Dim Command,ws
  167.     Set ws = CreateObject("wscript.Shell")
  168.     Command = "Cmd /C Taskkill /IM wscript.exe /F >nul 2>&1"
  169.     ws.run Command,0,True
  170.     Exit Sub
  171. End Sub
  172. '--------------------------------------------------------------------------------------
  173. Sub Window_OnUnload()
  174.     Call Stop_Playing()
  175. End Sub
  176. '--------------------------------------------------------------------------------------
  177. sub Shortcut()
  178. dim shell,DesktopPath,Link,CurrentFolder,FullName,arrFN,HTA_Name
  179. Set Shell = CreateObject("WScript.Shell")
  180. CurrentFolder = shell.CurrentDirectory
  181. DesktopPath = Shell.SpecialFolders("Desktop")
  182. FullName = replace(Check_Internet_Connection.commandLine,chr(34),"")  
  183. arrFN=split(FullName,"\")  
  184. HTA_Name = arrFN(ubound(arrFN))
  185. Link = GetFilenameWithoutExtension(HTA_Name)
  186. Set link = Shell.CreateShortcut(DesktopPath & "\" & Link & ".lnk")
  187. link.Description = HTA_Name
  188. link.IconLocation = "nslookup.exe"
  189. link.TargetPath = CurrentFolder & "\" & HTA_Name
  190. link.WorkingDirectory = CurrentFolder
  191. Link.HotKey = "CTRL+ALT+C"
  192. link.Save
  193. end Sub
  194. '--------------------------------------------------------------------------------------
  195. Function GetFilenameWithoutExtension(FileName)
  196.     Dim Result, i
  197.     Result = FileName
  198.     i = InStrRev(FileName, ".")
  199.     If ( i > 0 ) Then
  200.         Result = Mid(FileName, 1, i - 1)
  201.     End If
  202.     GetFilenameWithoutExtension = Result
  203. End Function
  204. '-------------------------------------------------------------------------------------
  205. Function OSLang()
  206.     Dim dtmConvertedDate,strComputer,objWMIService,oss,os
  207.     Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
  208.     strComputer = "."
  209.     Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  210.     Set oss = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
  211.     For Each os in oss
  212.         OSLang = os.OSLanguage
  213.     Next
  214. End Function
  215. '-------------------------------------------------------------------------------------
  216. </script>
RAW Paste Data