Yes it is quite useful and I'm using it everyday in more and more of my programs.
I hope that I'm not being too obsessive here, I've added a couple of optimizations,
and fixed the bug in cases 2 & 4 where the temporary file was not being deleted.
Code: Select all
Procedure.S GetExternalIPAddress(TIMEOUT)
; RETURNS A STRING CONTAINING THE CURRENT IPv4 EXTERNAL ADDRESS.
; THIS PROCEDURE WILL STOP CHECKING WEBSITES AFTER TIMEOUT MILLISECONDS IMMEDIATELY EXIT
; A PREVIOUS CALL TO InitNetwork() IS REQUIRED.
; WHICH=1 EXTRACT IP ADDRESS FROM http://ip.gwhois.org/
; WHICH=2 EXTRACT IP ADDRESS FROM http://checkip.dyndns.org
; WHICH=3 EXTRACT IP ADDRESS FROM http://ipecho.net/plain
; WHICH=4 EXTRACT IP ADDRESS FROM http://hex0rs.coderbu.de/Sonstiges/ShowMyIp12.php
; WHICH=5 EXTRACT IP ADDRESS FROM http://www.cmyip.com
; WHICH=6 EXTRACT IP ADDRESS FROM http://lloydsplace.com/whatsmyip.php
; WHICH=7 EXTRACT IP ADDRESS FROM http://www.realip.info/api/p/realip.php
; WHICH=8 EXTRACT IP ADDRESS FROM http://www.iplocation.net/
; WHICH=9 EXTRACT IP ADDRESS FROM http://www.whatsmyip.net/
WHICH= Random(8)+ 1 : START= WHICH
EXTADDR$= ""
If TIMEOUT < 1 : TIMEOUT= 10 : EndIf
STOPTIME= ElapsedMilliseconds()+ TIMEOUT
Repeat
If ElapsedMilliseconds() < STOPTIME
Select WHICH
Case 1
If ReceiveHTTPFile("http://ip.gwhois.org/","IPADDRESS")
ReadFile(1,"IPADDRESS") : EXTADDR$= ReadString(1)
EndIf
Case 2
HEADER$= GetHTTPHeader("http://checkip.dyndns.org")
STIND= FindString(HEADER$, "Current IP Address:", 1)+ 20
IND= FindString(HEADER$,"</body></html>",1)- STIND
If IND > 0 : EXTADDR$ = Mid(HEADER$,STIND,IND) : EndIf
Case 3
If ReceiveHTTPFile("http://ipecho.net/plain","IPADDRESS")
ReadFile(1,"IPADDRESS") : EXTADDR$= ReadString(1)
EndIf
Case 4
EXTADDR$= StringField(GetHTTPHeader("http://hex0rs.coderbu.de/Sonstiges/ShowMyIp12.php"),2,Chr(34))
Case 5
If ReceiveHTTPFile("http://www.cmyip.com","IPADDRESS")
ReadFile(1,"IPADDRESS")
Dim sIP.s(0) : sIP(0) = ""
While Eof(1) = 0 And sIP(0) = ""
EXTADDR$= ReadString(1)
If FindString(EXTADDR$,"My IP Address",1)
CreateRegularExpression(0,"\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}")
If ExtractRegularExpression(0,EXTADDR$,sIP()) > 0 : EXTADDR$= sIP(0) : EndIf
FreeRegularExpression(0)
EndIf
Wend
EndIf
Case 6
If ReceiveHTTPFile("http://lloydsplace.com/whatsmyip.php","IPADDRESS")
ReadFile(1,"IPADDRESS") : EXTADDR$= ReadString(1)
EndIf
Case 7
If ReceiveHTTPFile("http://www.realip.info/api/p/realip.php","IPADDRESS")
ReadFile(1,"IPADDRESS")
Dim sIP.s(0) : sIP(0) = ""
While Eof(1) = 0 And sIP(0) = ""
EXTADDR$= ReadString(1)
CreateRegularExpression(0,"\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}")
If ExtractRegularExpression(0,EXTADDR$,sIP()) > 0 : EXTADDR$= sIP(0) : EndIf
FreeRegularExpression(0)
Wend
EndIf
Case 8
If ReceiveHTTPFile("http://www.iplocation.net/","IPADDRESS")
ReadFile(1,"IPADDRESS")
Dim sIP.s(0) : sIP(0) = ""
While Eof(1) = 0 And sIP(0) = ""
EXTADDR$= ReadString(1)
If FindString(EXTADDR$,"Your IP Address is",1)
CreateRegularExpression(0,"\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}")
If ExtractRegularExpression(0,EXTADDR$,sIP()) > 0 : EXTADDR$= sIP(0) : EndIf
FreeRegularExpression(0)
EndIf
Wend
EndIf
Case 9
If ReceiveHTTPFile("http://www.whatsmyip.net/","IPADDRESS")
ReadFile(1,"IPADDRESS")
Dim sIP.s(0) : sIP(0) = ""
While Eof(1) = 0 And sIP(0) = ""
EXTADDR$= ReadString(1)
If FindString(EXTADDR$," Address is ",1)
CreateRegularExpression(0,"\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}")
If ExtractRegularExpression(0,EXTADDR$,sIP()) > 0 : EXTADDR$= sIP(0) : EndIf
FreeRegularExpression(0)
EndIf
Wend
EndIf
EndSelect
If IsFile(1)
CloseFile(1) : DeleteFile("IPADDRESS")
EndIf
If CountString(EXTADDR$,".")<>3 Or Len(EXTADDR$)<7 Or Len(EXTADDR$)>15 : EXTADDR$= "" : EndIf
EndIf
WHICH +1 : If WHICH=10 : WHICH= 1 : EndIf
Until EXTADDR$<>"" Or WHICH=START
ProcedureReturn EXTADDR$
EndProcedure
Unfortunately, AVIRA started to object to the object again.
Because I doubt if I'll be changing it anymore, I'm going to add my little ShowMyIPs.exe utility to AVIRA's exceptions list.
Code: Select all
InitNetwork() : ExamineIPAddresses() : EXTADDR$= GetExternalIPAddress(4000)
If EXTADDR$<>""
BUFF$= "EXTERNAL IPv4 = "+EXTADDR$
Else
BUFF$= "UNABLE TO RETRIEVE EXTERNAL ADDRESS"
EndIf
MessageRequester(BUFF$," INTERNAL LAN ADDRESS = "+IPString(NextIPAddress())+" ",#PB_MessageRequester_Ok)