Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Main.Bas (Wiki/Stupi/GBO)
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 16.07.2007 08:55:20 |
'----------------------------------------------------------------------------------------------------------------------------------------------------------'
#inclib "SDL_net"
'Global Information from SDL_net
Type Uint16 as ushort
type Uint32 as uinteger
type IPaddress
host as Uint32
port as Uint16
end type
Type TCPsocket as _TCPsocket ptr
Extern "c"
declare function SDLNet_Init () as integer
declare function SDLNet_ResolveHost (byval address as IPaddress ptr, byval host as zstring ptr, byval port as Uint16) as integer
declare function SDLNet_TCP_Open (byval ip as IPaddress ptr) as TCPsocket
declare function SDLNet_TCP_Recv (byval sock as TCPsocket, byval data as any ptr, byval maxlen as integer) as integer
declare function SDLNet_TCP_Send (byval sock as TCPsocket, byval data as any ptr, byval len as integer) as integer
declare sub SDLNet_TCP_Close (byval sock as TCPsocket)
declare sub SDLNet_Quit ()
End Extern
'----------------------------------------------------------------------------------------------------------------------------------------------------------'
Const recv_timeout = 10 '100 seconds
Const RECVBUFFLEN = 8192
Const NEWLINE = !"\r\n"
Const Referer = ""
Declare Function TCP_open (Byval hostname As String) As TCPSocket
Declare Function TCP_http (Byval method As String="get", Byval Socket As TCPSocket, Byval hostname As String, Byval path As String="") As Integer
Declare Function TCP_recv (Byval socket As TCPSocket) As String
Declare Function TCP_close (Byval socket As TCPSocket) As Integer
'----------------------------------------------------------------------------------------------------------------------------------------------------------'
'****************************************************************
Function TCP_open (Byval hostname As String) As TCPSocket
'****************************************************************
'' init
If( SDLNet_Init <> 0 ) Then
'print "Error: SDLNet_Init failed"
Return 0
End If
'' resolve
Dim ip As IPAddress
Dim socket As TCPSocket
If( SDLNet_ResolveHost( @ip, hostname, 80 ) <> 0 ) Then
'print "Error: SDLNet_ResolveHost failed"
Return 0
End If
'' open
socket = SDLNet_TCP_Open( @ip )
If( socket = 0 ) Then
'print "Error: SDLNet_TCP_Open failed"
Return 0
End If
Return socket
'****************************************************************
End Function 'TCP_open
'****************************************************************
'****************************************************************
Function TCP_http (Byval method As String="get", _
Byval Socket As TCPSocket, _
Byval hostname As String, _
Byval path As String="") As Integer
'****************************************************************
'' send HTTP request
Dim sendbuffer As String
Dim MString As String
Select Case Lcase (method)
Case "get"
MString="GET /"
Case "post"
MString="POST /"
Case Else
MString="GET /"
End Select
SendBuffer= _
MString+path+" HTTP/1.1"+NEWLINE+ _
"Host: "+hostname+NEWLINE+ _
"Connection: close"+NEWLINE
If MString="POST /" Then SendBuffer+= _
"Accept-Encoding: gzip"+NEWLINE
SendBuffer+= _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"+NEWLINE+ _
"Accept-Language: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3"+NEWLINE+ _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7"+NEWLINE+ _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4"+NEWLINE+ _
"Referer: "+Referer+NEWLINE
If MString="POST /" Then SendBuffer+= _
"Content-type: application/x-www-form-urlencoded"+NEWLINE
SendBuffer+=NEWLINE
If( SDLNet_TCP_Send( socket, Strptr( sendbuffer ), Len( sendbuffer ) ) < Len( sendbuffer ) ) Then
'print "Error: SDLNet_TCP_Send failed"
Return -1
End If
Return 0
'****************************************************************
End Function 'TCP_http
'****************************************************************
'****************************************************************
Function TCP_recv (Byval socket As TCPSocket) As String
'****************************************************************
Dim TimeOut As Single
Dim TimeOutX As Single
TimeOut=Timer
'' receive til connection is closed
Dim recvbuffer As Zstring * RECVBUFFLEN+1
Dim recv_Buffer as String
Dim bytes As Integer
Do
If TimeOutX>recv_TimeOut Then Exit Do
bytes = SDLNet_TCP_Recv( socket, Strptr( recvbuffer ), RECVBUFFLEN )
If( bytes <= 0 ) Then
Sleep (100),1
Else
timeout=Timer
End If
'' add the null-terminator
recvbuffer[bytes] = 0
'' print it as string
'Print recvbuffer;
recv_Buffer+=mid(recvbuffer,1,Len(recvbuffer)-1)
TimeOutX=Timer-TimeOut
Loop While Instr(Lcase(recvbuffer),"</html>")=0
Return recv_Buffer
'****************************************************************
End Function 'TCP_recv
'****************************************************************
'****************************************************************
Function TCP_close (Byval socket As TCPSocket) As Integer
'****************************************************************
'' close socket
SDLNet_TCP_Close( socket )
'' quit
SDLNet_Quit
Return 0
'****************************************************************
End Function 'TCP_close
'****************************************************************
'----------------------------------------------------------------------------------------------------------------------------------------------------------'