Código:
Dim i As Integer
Private Sub CambiarProxy(strProxyServer As String)
' ubicacion en la registry
Dim strRegPath
strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
Set oWshShell = CreateObject("WScript.Shell")
' modifica las entradas en el registro
Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000001", "REG_DWORD")
Call oWshShell.RegWrite(strRegPath & "ProxyOverride", "<local>", "REG_SZ")
Call oWshShell.RegWrite(strRegPath & "ProxyServer", strProxyServer, "REG_SZ")
' notificacion
MsgBox "Proxy setting enabled. " & vbCrLf & "Server - " & strProxyServer
' destroy
Set oWshShell = Nothing
End Sub
Private Sub QuitarProxy()
Dim strRegPath
' ubicacion en la registry
strRegPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\"
Set oWshShell = CreateObject("WScript.Shell")
' modifica las entradas en el registro
Call oWshShell.RegWrite(strRegPath & "ProxyEnable", "00000000", "REG_DWORD")
' notificacion
MsgBox "Proxy setting disabled"
' destroy
Set oWshShell = Nothing
End Sub
Private Sub cargar(lw As ListBox, fname As String)
'carga una lista de servidores de un txt cada servidor en una linea y separdo del puerto por :
Dim dire As String
dire = App.Path + "\" + fname
Open dire For Input As #1
While Not EOF(1)
Line Input #1, file_data$
lw.AddItem file_data$
Wend
Close #1
End Sub
Private Function pinga(ip As String) As Boolean
'Funcion que hace un ping a una ip devuelve true si hace pong
Dim conectado As Boolean
Dim Reply As ICMP_ECHO_REPLY
Dim lngSuccess As Long
Dim strIPAddress As String
conectado = False
'Get the sockets ready.
If SocketsInitialize() Then
'Address to ping
strIPAddress = ip
'Ping the IP that is passing the address and get a reply.
lngSuccess = ping(strIPAddress, Reply)
'Display the results.
If EvaluatePingResponse(lngSuccess) <> "Success!" Then
conectado = False
Else
conectado = True
End If
'Clean up the sockets.
SocketsCleanup
Else
'Winsock error failure, initializing the sockets.
conectado = False
pinga = conectado
End If
pinga = conectado
End Function
Private Sub Command1_Click()
cargar List1, "proxys.txt"
End Sub
Private Sub Command2_Click()
'boton que hace ping y saca el resultado con 2 shape uno verde y otro rojo
Dim ip
Dim ipbuena As String
ip = Split(List1.Text, ":")
ipbuena = ip(0)
If pinga(ipbuena) = True Then
rojo.Visible = False
verde.Visible = True
Else
rojo.Visible = True
verde.Visible = False
End If
End Sub
Private Sub Command3_Click()
'cambia el proxy desde una lista de proxys
'utilizando el registro de windows
CambiarProxy List1.Text
End Sub
Private Sub Command4_Click()
WebBrowser1.Navigate txt_url.Text
End Sub
Private Sub Command5_Click()
'boton que inutiliza el proxy en iexplorer
QuitarProxy
End Sub
Private Sub Form_Load()
On Error Resume Next
i = 0
cargar List1, "proxys.txt"
'añade ips locales para hacer pruebas de ping
List1.AddItem "192.168.1.1:80"
List1.AddItem "192.168.1.4:80"
End Sub
Bueno un saludo Gracias