PureBoard

Code: Alles auswählen

;+---------------------------------------------+
;|  GetMyExternIP-Procedure                    |
;|                                             |
;|  Procedure to get your external IP          |
;|                                             |
;|  Called as Thread (absolutely Threadsafe!)  |
;|                                             |
;|  (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!          |
;+---------------------------------------------+

Procedure GetMyExternIP(*IP.long)

	Protected NetID.l, *MyBuffer, Length.l, Factor.l, TimeOUT.l, *Pointer.BYTE, i.l, *Start, P.l

	*Start    = ?GetMyExtIPData
	*MyBuffer = AllocateMemory(8192)
	If *MyBuffer
		PokeL(*MyBuffer, ' TEG') ;"GET "
		While MemoryStringLength(*Start)
			CopyMemory(*Start, *MyBuffer + 4, MemoryStringLength(*Start) + 1)
			*Start + MemoryStringLength(*Start) + 1
			NetID = OpenNetworkConnection(PeekS(*Start), 80)
			If NetID
				CopyMemory(?GetMyExtIPHeader1, *MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4), MemoryStringLength(?GetMyExtIPHeader1) + 1)
				CopyMemory(*Start, *MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4), MemoryStringLength(*Start) + 1)
				CopyMemory(?GetMyExtIPHeader2, *MyBuffer + 4 + MemoryStringLength(*MyBuffer + 4), MemoryStringLength(?GetMyExtIPHeader2) + 1)
				SendNetworkData(NetID, *MyBuffer, MemoryStringLength(*MyBuffer))
				Break
			EndIf
			*Start + MemoryStringLength(*Start) + 1
		Wend
		If NetID
			TimeOUT = ElapsedMilliseconds() + 3000 ;3 Seconds
			Repeat
				Select NetworkClientEvent(NetID)
					Case 0
						Delay(5)
					Case #PB_NetworkEvent_Data
						P = ReceiveNetworkData(NetID, *MyBuffer + Length, 8192 - Length)
						If P > 0
							Length + P
							Dim Values.l(4)
							Values(0) = -1
							*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
								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
	GetMyExtIPHeader1:
	Data.s " HTTP/1.1" + #CRLF$ + "Host: "
	GetMyExtIPHeader2:
	Data.s #CRLF$ + "User-Agent: Mozilla/5.0" + #CRLF$ + #CRLF$

	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.b 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