PureBoard

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