No agrego para ver las banderitas porque el puto vb6 no carga .png solo usando modulos pero...
Creido: Himanen por el split & pink por la idea original, besos
Creido: Himanen por el split & pink por la idea original, besos
Componentes a usar: 1 List1, 1 Textbox, 1 Boton
Código: Seleccionar todo
Private Sub Command1_Click()
Dim Source As String
Dim Data As String
Dim obtener As String
Dim IP As String
IP = Text1
obtener = GetHTMLSource("http://freegeoip.net/xml/" & IP)
List1.Clear
List1.AddItem ("IP: " & sSplit(obtener, "<Ip>", "</Ip>"))
List1.AddItem ("Country Code: " & sSplit(obtener, "<CountryCode>", "</CountryCode>"))
List1.AddItem ("Country Name: " & sSplit(obtener, "<CountryName>", "</CountryName>"))
List1.AddItem ("Region Code: " & sSplit(obtener, "<RegionCode>", "</RegionCode>")) '
List1.AddItem ("Region Name: " & sSplit(obtener, "<RegionName>", "</RegionName>"))
List1.AddItem ("City: " & sSplit(obtener, "<City>", "</City>"))
List1.AddItem ("ZipCode: " & sSplit(obtener, "<ZipCode>", "</ZipCode>"))
List1.AddItem ("Latitude: " & sSplit(obtener, "<Latitude>", "</Latitude>"))
List1.AddItem ("Longitude: " & sSplit(obtener, "<Longitude>", "</Longitude>"))
List1.AddItem ("MetroCode: " & sSplit(obtener, "<MetroCode>", "</MetroCode>"))
End Sub
Function GetHTMLSource(ByVal sURL As String) As String
Static id As Long
id = id + 1
If id >= 60000 Then
id = 0
End If
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XmlHttp")
xmlHttp.Open "GET", sURL & "?i=" & id, False
xmlHttp.Send
GetHTMLSource = xmlHttp.responseText
Set xmlHttp = Nothing
End Function
Public Function sSplit(Texto As String, del1 As String, del2 As String) As String ' by Himanen
Dim p1 As Integer
Dim p2 As Integer
Dim tm As Integer
p1 = InStr(Texto, del1)
p2 = InStr(Texto, del2)
tm = p2 + Len(del2)
If del2 <> "" Then
sSplit = Mid(Texto, p1 + Len(del1), tm - (p1 + Len(del1) + Len(del2)))
Else
sSplit = Mid(Texto, p1 + Len(del1), Len(Texto) - (p1 + Len(del1)))
End If
End Function
