Your HTA program grabbed my curiosity. Unfortunately the screenshot attached is all that comes up and the music plays. I can double click on selections, but no change to DNS. Using Firefox Browser on Windows 7 64-bit Home Premium. Does this only work for Internet Explorer maybe? I dont use Internet Explorer, I use Firefox. Maybe I am missing some sort of dependency that I am unaware of. Looking at source I dont see whats missing at my end.
Here is the source code for others that want to take a look at the HTA source.
<html>
<head>
<HTA:APPLICATION
ID="oHTA"
APPLICATIONNAME="DNS Changer by Hackoo"
icon="nslookup.exe"
SCROLL="no"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="NO"
SINGLEINSTANCE="yes"
>
<title>Easily and quickly DNS Changer by Hackoo 2016</title>
<link rel="stylesheet" media="screen" type="text/css" title="design_encoder" href="http://hackoo.alwaysdata.net/design_encoder.css"/>
<style>
select option {
margin:40px;
background: black;
color:LightGreen;
text-shadow:0 1px 0 rgba(0,0,0,0.4);
}
body{
font-family:font-family :"Comic Sans MS";
background-color: Black;
}
</style>
</head>
<script language="VBScript">
Sub Window_Onload
'If HTAElevate() = True Then
CenterWindow 880, 650
Call CreerLstDyn()
txtBody.Value = ListDNSInfo
Call PlayRadio()
'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 CreerLstDyn()
Const ForReading = 1
Const ForWriting = 2
Dim fso,f,i,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Count = 0
Monfichier="ListDNS.ini"
If Not fso.FileExists(MonFichier) Then
CreateListDNS
End If
Set f = fso.OpenTextFile(MonFichier,ForReading)
contents=f.ReadAll()
Tab = split(contents,vbcrlf)
For i = lbound(Tab) to ubound(Tab) Step 2
If i Mod 2 = 0 then
Count = Count + 1
Set oOption = Document.createElement("OPTION")
oOption.Text = Count & " - " & Tab(i)
k = i+1
If k > UBound(tab) Then Exit For
oOption.Value = Tab(k)
lstDyn.Add(oOption)
End If
Next
End Sub
Sub ChangeDNS()
Dns= split(lstDyn.Value,",")
'Msgbox DblQuote(Dns(0)) & vbcr & DblQuote(Dns(1))
Call ChangeMyDNS(Dns(0),Dns(1))
end sub
'****************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************
Sub ChangeMyDNS(DNS1,DNS2)
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNetCards = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objNetCard in colNetCards
arrDNSServers = Array(DNS1,DNS2) 'DNS
objNetCard.SetDNSServerSearchOrder(arrDNSServers)
If Err = 0 Then
txtBody.Value = ListDNSInfo
Msgbox ListDNSInfo,VbInformation,"Configuration réseau de l'ordinateur"
Else
MsgBox Err.Description,Vbcritical,Err.Description
End If
Next
End Sub
'*******************************************************************************
Sub RestoreDNS()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNetCards = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objNetCard in colNetCards
objNetCard.SetDNSServerSearchOrder(null)
If Err = 0 Then
txtBody.Value = ListDNSInfo
Msgbox ListDNSInfo,VbInformation,"Configuration réseau de l'ordinateur"
Else
MsgBox Err.Description,Vbcritical,Err.Description
End If
Next
End sub
'************************************************************************************
Function ListDNSInfo()
Dim ComputerName,IPConfigSet,IPConfig,BailObtenu,BailExpirant
ComputerName="."
On error resume next
set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & ComputerName).ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE")
If Err.Number <> 0 Then
msgbox " - non accessible -"
Else
for each IPConfig in IPConfigSet
BailObtenu = IPConfig.DHCPLeaseObtained
BailExpirant = IPConfig.DHCPLeaseExpires
'---- Convertion des date et heure d'obtention et d'expiration des baux DHCP en un format lisible par l'utilisateur. ----
BailObtenu = mid(BailObtenu, 7, 2) & "/" & mid(BailObtenu, 5, 2) & "/" & mid(BailObtenu, 1, 4) & " - " & mid(BailObtenu, 9, 2)& ":" & mid(BailObtenu, 11, 2)& ":" & mid(BailObtenu, 13, 2)
BailExpirant = mid(BailExpirant, 7, 2) & "/" & mid(BailExpirant, 5, 2) & "/" & mid(BailExpirant, 1, 4) & " - " & mid(BailExpirant, 9, 2)& ":" & mid(BailExpirant, 11, 2)& ":" & mid(BailExpirant, 13, 2)
Msg = "Configuration réseau de l'ordinateur : " & IPConfig.DNSHostName & vbcrlf & vbcrlf & _
"Nom Machine " & vbtab & " : " & vbtab & IPConfig.DNSHostName & vbcrlf & vbcrlf & _
"Carte active" & vbtab & " : " & vbtab & IPConfig.Description & vbcrlf & vbcrlf & _
"Adresse MAC " & vbtab & " : " & vbtab & IPConfig.MACAddress & vbcrlf & _
"DHCP Activé" & vbtab & " : " & vbtab & IPConfig.DHCPEnabled & vbcrlf & vbcrlf & _
"Adresse IP " & vbtab & " : " & vbtab & IPConfig.IPAddress(0) & vbcrlf & _
"Masque " & vbtab & vbtab & " : " & vbtab & IPConfig.IPSubnet(0) & vbcrlf & _
"Passerelle " & vbtab & " : " & vbtab & IPConfig.DefaultIPGateway(0) & vbcrlf & _
"Serveur DHCP " & vbtab & " : " & vbtab & IPConfig.DHCPServer & vbcrlf & vbcrlf & _
"Serveur DNS " & vbtab & " : " & vbtab & IPConfig.DNSServerSearchOrder(0) & vbcrlf & _
" " & vbtab & vbtab & " : " & vbtab & IPConfig.DNSServerSearchOrder(1) & vbcrlf & _
vbcrlf & _
" Bail obtenu " & vbtab & " : " & vbtab & BailObtenu & vbcrlf & _
" Bail expirant " & vbtab & " : " & vbtab & BailExpirant
'"Serveur WINS " & vbtab & " : " & IPConfig.WINSPrimaryServer(0) & vbcrlf & _
'" " & vbtab & vbtab & " : " & IPConfig.WINSSecondaryServer(0)
'MsgBox Msg,VbInformation,"Configuration réseau de l'ordinateur "
Next
ListDNSInfo = Msg
End If
End Function
'****************************************************************************
Sub CreateListDNS()
Const ForWriting = 2
strFile = "ListDNS.ini"
Set FSO = CreateObject("Scripting.FileSystemObject")
set f = FSO.OpenTextFile _
(strFile, ForWriting, True)
f.WriteLine "US - Google Public DNS"
f.WriteLine "8.8.8.8,8.8.4.4"
f.WriteLine "US - Norton ConnectSafe DNS 1 (Anti-Porn)"
f.WriteLine "184.169.223.35,199.85.126.30"
f.WriteLine "US - OpenDNS Family (Anti-Porn)"
f.WriteLine "208.67.222.123,208.67.220.123"
f.WriteLine "RU - Yandex Family (Anti-Porn)"
f.WriteLine "77.88.8.3,77.88.8.7"
f.WriteLine "US - Norton ConnectSafe DNS 2"
f.WriteLine "198.153.192.1,198.153.194.1"
f.WriteLine "US - OpenDNS -"
f.WriteLine "208.67.222.222,208.67.220.220"
f.WriteLine "RU - Yandex -"
f.WriteLine "77.88.8.1,77.88.8.8"
f.WriteLine "RU - Yandex Safe"
f.WriteLine "77.88.8.2,77.88.8.88"
f.WriteLine "US - Comodo Secure"
f.WriteLine "8.26.56.26,8.20.247.20"
f.WriteLine "UK - Internap"
f.WriteLine "212.118.241.1,212.118.241.2"
f.WriteLine "UK - Fast Broadband"
f.WriteLine "78.143.192.10,78.143.192.20"
f.WriteLine "UK - BSO Network"
f.WriteLine "212.73.209.34,212.73.209.226"
f.WriteLine "US - Qwest"
f.WriteLine "205.171.3.65,205.171.2.65"
f.WriteLine "US - Centurytel"
f.WriteLine "74.4.19.187,207.14.235.234"
f.WriteLine "US - Sprint"
f.WriteLine "204.97.212.10,204.117.214.10"
f.WriteLine "US - SmartViper"
f.WriteLine "208.76.50.50,208.76.51.51"
f.WriteLine "US - CenturyLink DNS"
f.WriteLine "207.14.235.234,67.238.98.162"
f.WriteLine "DE - FoolDNS"
f.WriteLine "87.118.111.215,80.79.54.55"
f.WriteLine "AU - Exetel"
f.WriteLine "220.233.0.4,220.233.0.3"
f.WriteLine "DK - Censurfridns"
f.WriteLine "89.233.43.71,89.104.194.142"
f.WriteLine "TR - TurkTelekom"
f.WriteLine "195.175.39.40,195.175.39.39"
f.WriteLine "RU - Safe DNS"
f.WriteLine "195.46.39.39,195.46.39.40"
f.WriteLine "US - Unotelly"
f.WriteLine "173.199.144.68,206.214.214.28"
f.WriteLine "DE - Cesidian Root"
f.WriteLine "178.254.21.113,78.47.115.197"
f.WriteLine "MD - OpenNIC"
f.WriteLine "178.17.170.67,193.182.144.144"
f.WriteLine "DE - Open Root"
f.WriteLine "109.230.224.42,87.118.126.225"
f.WriteLine "FR - Open Root"
f.WriteLine "37.187.23.23,37.187.99.178"
f.WriteLine "DE - DNS WATCH"
f.WriteLine "84.200.69.80,84.200.70.40"
f.WriteLine "IL - GreenTeam"
f.WriteLine "81.218.119.11,209.88.198.133"
f.WriteLine "DE - ClaraNet"
f.Write "212.82.225.7,212.82.226.212"
Msg = DblQuote("ListDNS.ini") & " file is created successfully !"
MsgBox Msg,vbInformation,Msg
End Sub
'**************************************************************************
'*** v13.3 *** www.dieseyer.de *****************************
Function HTAElevate()
'***********************************************************
' Unter Windows x64 laufen VBS' nach einem Doppelklick in der x64-Umgebung
' mit %WinDi%\System32\wscript.exe oder mit %WinDi%\System32\cscript.exe.
' In der x64-Umgebung laufen VBS aber nicht (richtig). Die Prozedur
' HTAElevate() erkennt dies und startet ggf. das VBS in der
Const Elev = " /elevated"
' MsgBox oHTA.commandLine, , "5016 :: "
' Trace32Log "5018 :: oHTA.commandLine: ==" & oHTA.commandLine & "==", 1
HTAElevate = True
' If InStr( LCase( oHTA.commandLine ), Elev) > 0 then MsgBox oHTA.commandLine, , "5022 :: "
If InStr( LCase( oHTA.commandLine ), Elev) > 0 then Exit Function
On Error Resume Next
window.resizeto 750, 10 ' : window.moveto screen.width / 2, screen.height / 2
On Error GoTo 0
' MsgBox oHTA.commandLine, , "5030 :: "
createobject("Shell.Application").ShellExecute "mshta.exe", oHTA.commandLine & Elev, "", "runas", 1
HTAElevate = False
self.close
End Function ' HTAElevate()
'***********************************************************
Sub Play(URL)
Const ForWriting = 2
Set ws = CreateObject("WScript.Shell")
strFile = "%tmp%\DJBuzzRadio.vbs"
strFile = ws.ExpandEnvironmentStrings(strFile)
Set FSO = CreateObject("Scripting.FileSystemObject")
set f = FSO.OpenTextFile _
(strFile, ForWriting, True)
f.WriteLine "Dim Sound"
f.WriteLine "Set Sound = CreateObject(""WMPlayer.OCX"")"
f.WriteLine "Sound.URL = "& DblQuote(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.Write "wscript.sleep (int(Sound.currentmedia.duration)+1)*1000"
ws.run strFile
End Sub
'***********************************************************
Sub PlayRadio()
DJBuzzRadio = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(119)&ChrW(119)&ChrW(119)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(111)&ChrW(99)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(115)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(47)&ChrW(100)&ChrW(106)&ChrW(98)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(95)&ChrW(119)&ChrW(105)&ChrW(110)&ChrW(100)&ChrW(111)&ChrW(119)&ChrW(115)&ChrW(46)&ChrW(109)&ChrW(112)&ChrW(51)&ChrW(46)&ChrW(97)&ChrW(115)&ChrW(120)
Call Play(DJBuzzRadio)
End Sub
'***********************************************************
Sub StopRadio()
Set oCMD = CreateObject("WScript.Shell")
oCMD.Run "taskkill /f /im wscript.exe",0,True
End Sub
'***********************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'***********************************************************
Sub Window_OnUnload()
Call StopRadio()
End Sub
'***********************************************************
</script>
<body text="LightGreen" font-family: "Comic Sans MS", cursive, sans-serif;>
<center><B>Select one item and double click on it to change your DNS :</B><BR><br>
<SELECT NAME="lstDyn" select size="20" OndblClick="ChangeDNS()">
</SELECT>
<textarea id="txtBody" rows="20" cols="80"></textarea><br><br>
<input type="button" value="Restore your default DNS values" OnClick="RestoreDNS()">
<br><br>
<a href="http://stackexchange.com/users/3701028/hackoo"><img src="http://stackexchange.com/users/flair/3701028.png" width="208" height="58" alt="profile for Hackoo on Stack Exchange, a network of free, community-driven Q&A sites" title="profile for Hackoo on Stack Exchange, a network of free, community-driven Q&A sites" /></a><br><br>
<!--<input type="button" value="Play DJBuzz Radio" OnClick="PlayRadio()">-->
<input type="button" value="Stop the music of DJ Buzz Radio" OnClick="StopRadio()">
</center>
</body>
</html>And here is the INI file contents that pair with it:
US - Google Public DNS
8.8.8.8,8.8.4.4
US - Norton ConnectSafe DNS 1 (Anti-Porn)
184.169.223.35,199.85.126.30
US - OpenDNS Family (Anti-Porn)
208.67.222.123,208.67.220.123
RU - Yandex Family (Anti-Porn)
77.88.8.3,77.88.8.7
US - Norton ConnectSafe DNS 2
198.153.192.1,198.153.194.1
US - OpenDNS -
208.67.222.222,208.67.220.220
RU - Yandex -
77.88.8.1,77.88.8.8
RU - Yandex Safe
77.88.8.2,77.88.8.88
US - Comodo Secure
8.26.56.26,8.20.247.20
UK - Internap
212.118.241.1,212.118.241.2
UK - Fast Broadband
78.143.192.10,78.143.192.20
UK - BSO Network
212.73.209.34,212.73.209.226
US - Qwest
205.171.3.65,205.171.2.65
US - Centurytel
74.4.19.187,207.14.235.234
US - Sprint
204.97.212.10,204.117.214.10
US - SmartViper
208.76.50.50,208.76.51.51
US - CenturyLink DNS
207.14.235.234,67.238.98.162
DE - FoolDNS
87.118.111.215,80.79.54.55
AU - Exetel
220.233.0.4,220.233.0.3
DK - Censurfridns
89.233.43.71,89.104.194.142
TR - TurkTelekom
195.175.39.40,195.175.39.39
RU - Safe DNS
195.46.39.39,195.46.39.40
US - Unotelly
173.199.144.68,206.214.214.28
DE - Cesidian Root
178.254.21.113,78.47.115.197
MD - OpenNIC
178.17.170.67,193.182.144.144
DE - Open Root
109.230.224.42,87.118.126.225
FR - Open Root
37.187.23.23,37.187.99.178
DE - DNS WATCH
84.200.69.80,84.200.70.40
IL - GreenTeam
81.218.119.11,209.88.198.133
DE - ClaraNet
212.82.225.7,212.82.226.212
[attachment deleted by admin to conserve space]
