Hab noch ein paar kleinere Veränderungen gemacht.
Nun noch für die Stichwortsuche:
Diese Funktion ermöglicht es eure externe IP festzustellen, wenn ihr hinter nem Router steckt.
Im Code sind die beiden URLs von ts-soft und winduff zur IP-Ermittlung enthalten. Der Traffic dürfte zwar minimal sein, dennoch würde ich vorschlagen die beiden zu fragen, oder besser noch den wahnsinnig aufregenden und komplexen php-code auf euren eigenen Webspace zu laden.
Einfach die neue URL + Pfad in die DataSection aufnehmen (wird von oben nach unten abgearbeitet) und fertig.
Code: Alles auswählen
;+---------------------------------------------+
;| GetMyExternIP-Procedure |
;| |
;| Procedure to get your external IP |
;| |
;| Called as Thread (absolutely Threadsafe!) |
;| UNICODE Supported |
;| |
;| (c)HeX0R 2006 |
;| http://h3x0r.ath.cx |
;| mailto:h3x0r [a t] h3x0r.ath.cx |
;| |
;| |
;| For compiling this source you will |
;| need at least PureBasic 4.00! |
;| AND NO NEED OF ANY EXTERNAL LIBS! |
;+---------------------------------------------+
Macro _MemoryStringLength(a)
MemoryStringLength(a) * SizeOf(CHARACTER)
EndMacro
Procedure GetMyExternIP(*IP.long)
Protected A.l, i.l, P.l, NetID.l, Length.l, Factor.l, TimeOUT.l, *MyBuffer, *Pointer.BYTE, *Start
*Start = ?GetMyExtIPData
*MyBuffer = AllocateMemory(8192)
If *MyBuffer
PokeS(*MyBuffer, "GET ", -1, #PB_Ascii)
While _MemoryStringLength(*Start)
PokeS(*MyBuffer + 4, PeekS(*Start), -1, #PB_Ascii)
*Start + _MemoryStringLength(*Start) + SizeOf(CHARACTER)
PokeS(*MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4, #PB_Ascii), " HTTP/1.1" + #CRLF$ + "Host: ", -1, #PB_Ascii)
i = 4 + MemoryStringLength(*MyBuffer + 4, #PB_Ascii)
PokeS(*MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4, #PB_Ascii), PeekS(*Start), -1, #PB_Ascii)
NetID = OpenNetworkConnection(PeekS(*MyBuffer + i, -1, #PB_Ascii), 80)
If NetID
PokeS(*MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4, #PB_Ascii), #CRLF$ + "User-Agent: Mozilla/5.0" + #CRLF$ + #CRLF$, -1, #PB_Ascii)
P = 0
i = MemoryStringLength(*MyBuffer, #PB_Ascii)
While P < i
Length = SendNetworkData(NetID, *MyBuffer + P, i - P)
If Length = -1
CloseNetworkConnection(NetID)
NetID = 0
Break
EndIf
P + Length
Wend
If P = i
Break
EndIf
EndIf
*Start + _MemoryStringLength(*Start) + SizeOf(CHARACTER)
Wend
If NetID
Dim Values.l(3)
Values(0) = -1
TimeOUT = ElapsedMilliseconds() + 3000 ;3 Seconds
Length = 0
Repeat
Select NetworkClientEvent(NetID)
Case 0
Delay(5)
Case #PB_NetworkEvent_Data
P = ReceiveNetworkData(NetID, *MyBuffer + Length, 8192 - Length)
If P > 0
Length + P
*Pointer = *MyBuffer + Length
Factor = 1
i = 3
Repeat
If *Pointer\b >= '0' And *Pointer\b <= '9'
Values(i) + Factor * (*Pointer\b - '0')
Factor * 10
ElseIf *Pointer\b = '.'
Factor = 1
i - 1
Values(i) = 0
ElseIf i = 0
Break
Else
i = 3
Factor = 1
Values(0) = -1
Values(3) = 0
EndIf
*Pointer - 1
Until *Pointer < *MyBuffer
If Values(0) <> -1
*IP\l = MakeIPAddress(Values(0), Values(1), Values(2), Values(3))
Break
EndIf
EndIf
EndSelect
If TimeOUT < ElapsedMilliseconds()
Break
EndIf
ForEver
CloseNetworkConnection(NetID)
EndIf
FreeMemory(*MyBuffer)
EndIf
EndProcedure
DataSection
GetMyExtIPData:
Data.s "/getip.php" ;path
Data.s "www.ts-soft.eu" ;url
;
Data.s "/ip.php" ;path
Data.s "www.eimex.de" ;url
;
;Add more if whished
Data.c 0
EndDataSection
;>>>>>End Of Include<<<<<
;-------------------------------------------------
;Example
Define.l MyIP
InitNetwork()
If OpenWindow(0, 227, 117, 169, 37, "GetMyExtIP", #PB_Window_SystemMenu | #PB_Window_TitleBar )
If CreateGadgetList(WindowID(0))
TextGadget(0, 10, 10, 20, 20, "IP:")
IPAddressGadget(1, 40, 10, 120, 20)
If CreateThread(@GetMyExternIP(), @MyIP)
Repeat
Select WaitWindowEvent(100)
Case #PB_Event_CloseWindow
Break
Case 0
If MyIP <> 0 And GetGadgetState(1) <> MyIP
SetGadgetState(1, MyIP)
EndIf
EndSelect
ForEver
EndIf
EndIf
EndIf
Unicode sollte nun auch gehn...
