PureBasic Forums - English

Code: Select all

;################
;#     Show-IP  #
;#    (p) 2010  #
;# quadWorks.de #
;################

; ##############################################################################################
; This code is licensed under Creative Commons:  http://creativecommons.org/licenses/by-sa/3.0/
; Means: you may alter the code, but have to give the changes back. You may use it commercially.
; ##############################################################################################

; You need a web-server offering PHP. Then setup a file test.php on your server with this content
;
; <?php echo $_SERVER['REMOTE_ADDR']; ?>
;
; That's it :-)
; The Domain and filename (e.g. test.php) have to be used in
; line 160: RemoteIP.s = HTTP_Get_Program_Version("www.test.com", 80, "test.php") 

;{ HTTP-Part ... This is a snippet from my HTTP.PBI-Library

; - Errorcodes
#HTTP_OK               = 200  ; no error, everything ok
#HTTP_File_Not_Found   = 404  ; File Not Found
;#HTTP_Server_Error     = 500  ; Internal Server Error
#HTTP_No_Connection    = 1    ; Not Connected
#HTTP_Server_Not_Found = 2    ; Server Not Found
#HTTP_No_Size          = 3    ; Server gave no filesize

#CRLF                         = Chr(13) + Chr(10)

#HTTP_Buffer_Length           = 2048
Global *HTTP_Buffer           = AllocateMemory(#HTTP_Buffer_Length)
Global *HTTP_Binary_Buffer    = 0
Global HTTP_LastAnswer$       = ""
Global HTTP_ErrorCode         = 0
Global HTTP_Content$          = ""
Global HTTP_Downloaded_Size   = 0  ; contains size of downloaded File when finished
Global HTTP_Downloaded_Name$  = "" ; conatins name of downloaded File when finished
Global HTTP_Downloaded_Amount = 0  ; contains size of data already downloaded
Global HTTP_Download_Finished = 0  ; contains 1 if download has finished

Procedure.s Get_Between(FromWhat$, Before$, After$) ; OK
Define Position = FindString(FromWhat$, Before$, 0) + Len(Before$)
Define Laenge   = FindString(FromWhat$, After$, Position) - Position
ProcedureReturn Mid(FromWhat$, Position, Laenge)
EndProcedure

Procedure.l HTTP_Get_From_Server(Connection, Query$)
 Define Result
 Define Beginn
 
 If Connection    = 0
  HTTP_ErrorCode  = #HTTP_No_Connection
 Else
  SendNetworkString(Connection, Query$)                                                      ; Send to connected Server
  HTTP_Download_Finished = 0  
  Result                 = ReceiveNetworkData(Connection, *HTTP_Buffer, #HTTP_Buffer_Length) ; Bytes read
  HTTP_LastAnswer$       = PeekS(*HTTP_Buffer, Result, #PB_Ascii)                            ; save whole Answer
  HTTP_ErrorCode         = Val(Get_Between(HTTP_LastAnswer$, "HTTP/1.1 ", " "))
  If FindString(HTTP_LastAnswer$, "This File Does Not Exist!", 0) <> 0
   ProcedureReturn #HTTP_File_Not_Found
  EndIf
  HTTP_Downloaded_Name$  = Get_Between(HTTP_LastAnswer$, "filename=" + Chr(34), Chr(34))
  If *HTTP_Binary_Buffer
   FreeMemory(*HTTP_Binary_Buffer)
  EndIf
  If HTTP_ErrorCode = #HTTP_OK                                                         ; no error (= 200)
   HTTP_Downloaded_Size  = Val(Get_Between(HTTP_LastAnswer$, "Content-Length: ", #CRLF))   
   Beginn                = FindString(HTTP_LastAnswer$, #CRLF + #CRLF, 0) + 3 
   If HTTP_Downloaded_Size > Result
    *HTTP_Binary_Buffer  = AllocateMemory(HTTP_Downloaded_Size)
    HTTP_Downloaded_Amount = Result - Beginn
    CopyMemory(*HTTP_Buffer + Beginn, *HTTP_Binary_Buffer, HTTP_Downloaded_Amount)
    While Result <> 0
     Result   = ReceiveNetworkData(Connection, *HTTP_Binary_Buffer + HTTP_Downloaded_Amount, HTTP_Downloaded_Size)
     HTTP_Downloaded_Amount = HTTP_Downloaded_Amount + Result
    Wend
   Else
    HTTP_Content$ = Mid(HTTP_LastAnswer$, Beginn + 1, HTTP_Downloaded_Size + 1)
   EndIf
   HTTP_Downloaded_Size = HTTP_Downloaded_Amount
   HTTP_ErrorCode = #HTTP_OK
   HTTP_Download_Finished = 1
  Else
   HTTP_ErrorCode = #HTTP_No_Size
  EndIf
 EndIf
 ProcedureReturn HTTP_ErrorCode 
EndProcedure

Procedure.s HTTP_Make_Get(URL$, File$, Parameter$ = "0")
 Define Param$, query$

 If Parameter$ <> "0"
  Param$ = "?" + Parameter$
 Else
  Param$ = ""
 EndIf
 Query$ = "GET /" + File$ + Param$ + " HTTP/1.1" + #CRLF
 Query$ + "Host: " + URL$ + #CRLF
 Query$ + "Connection: Close" + #CRLF + #CRLF
 ProcedureReturn Query$
EndProcedure 

Procedure.l HTTP_Connect_Server(Server$, Port = 80) ; OK
 Define Connection = OpenNetworkConnection(Server$, Port)
 If Connection  = 0
  HTTP_ErrorCode = #HTTP_Server_Not_Found
 Else
  HTTP_ErrorCode = #HTTP_OK
 EndIf
 ProcedureReturn Connection
EndProcedure

Procedure.s HTTP_Get_Program_Version(Server$, Port, File$)
 Define Connection, Query$, Where

 Connection = HTTP_Connect_Server(Server$, Port)
 Query$     = HTTP_Make_Get(Server$, File$)
 Where      = HTTP_Get_From_Server(Connection, Query$)
 If Where <> #HTTP_OK
  HTTP_Content$ = "error"
 EndIf
 If Connection <> 0
  CloseNetworkConnection(Connection)
 EndIf
 ProcedureReturn HTTP_Content$
EndProcedure

;}

Procedure   Draw_On_Image(Text$, Text2$ = "")
 StartDrawing(ImageOutput(0))
  DrawingFont(FontID(0))
  x = TextWidth(Text$) + 2
  ResizeImage(0,x,16,#PB_Image_Smooth)
 StopDrawing()
 StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_AlphaChannel|#PB_2DDrawing_Transparent)
  Box(0, 0, ImageWidth(0), ImageHeight(0), RGBA(0,0,0,0))
  DrawingFont(FontID(0))
  DrawText(1,0,Text$,RGBA(0,0,0,255))
  DrawText(1,9,Text2$,RGBA(0,0,0,255))
 StopDrawing()
EndProcedure
 
 If InitNetwork() = 0
   MessageRequester("Information", "No network available or found. Please check connections, and network.")
 EndIf
 
 ExamineIPAddresses()
 IP = NextIPAddress()
 If IP <> 0
  IPs.s = IPString(ip)
 EndIf
 
 RemoteIP.s = HTTP_Get_Program_Version("www.test.com", 80, "test.php")
 LoadFont(0,"Arial",8)
 
 CreateImage   ( 0,  80,  16,  32)
 OpenWindow    ( 0,   0,   0,   1,   1, "Show-IP",#PB_Window_BorderLess)
 Draw_On_Image(IPs,RemoteIP)
 AddSysTrayIcon(0, WindowID(0), ImageID(0))
 SysTrayIconToolTip(0, "You local IP: " + IPs + #CR$ + "Your remote-IP: " + RemoteIP + #CR$ + "Click here To quit.")
 Exit = 0

Repeat
 Select WaitWindowEvent()
  Case #PB_Event_SysTray
   Select EventType()
    Case #PB_EventType_LeftClick
     Exit = 1
   EndSelect
 EndSelect
Until Exit = 1