Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
13.1: HTTP-Anfrage über GET
| Uploader: |  nemored |
| Datum/Zeit: | 24.08.2013 16:23:42 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts OpenBook: 2D-Spieleprogrammierung, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
' *** CODE 13.1: HTTP-Anfrage über GET
' Notwendige Bibliotheken einbinden
#ifdef __FB_WIN32__
#include once "win/winsock2.bi"
#else
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/unistd.bi"
#endif
const RECVBUFFLEN = 8192
const NEWLINE = !"\r\n"
sub getHostAndPath(byref src as string, byref hostname as string, _
byref path as string)
dim p as integer = instr(src, " ")
if p = 0 or p = len(src) then
hostname = trim(src)
path = ""
else
hostname = trim(left(src, p-1))
path = trim(mid(src, p+1))
end if
end sub
function resolveHost(hostname as string) as integer
dim ia as in_addr, hostentry as hostent ptr
' pruefen, ob es sich um eine IP-Adresse handelt
ia.S_addr = inet_addr(hostname)
if ia.S_addr = INADDR_NONE then
' wenn nicht, dann den Namen aufloesen
hostentry = gethostbyname( hostname )
if hostentry = 0 then exit function
return *cast( integer ptr, *hostentry->h_addr_list )
else
return ia.S_addr
end if
end function
function httpGet(hostname as string, path as string) as string
dim as string ret
' Hostname aufloesen
dim ip as integer, position as integer = 0, s as SOCKET
ip = resolveHost(hostname)
if ip = 0 then return "Ungueltige Adresse!"
' Socket oeffnen
s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
if s = 0 then return "Socket-Fehler!"
' zum Host verbinden
dim sa as sockaddr_in
sa.sin_port = htons(80)
sa.sin_family = AF_INET
sa.sin_addr.S_addr = ip
if connect(s, cast( PSOCKADDR, @sa), len(sa)) = SOCKET_ERROR then
closesocket s
return "Verbindungsfehler!"
end if
' HTTP-Anfrage senden
dim sendbuffer as string
sendBuffer = "GET /" & path & " HTTP/1.0" & NEWLINE & _
"Host: " & hostname & NEWLINE & _
"Connection: close" & NEWLINE & _
"User-Agent: GetHTTP 0.0" & NEWLINE & _
NEWLINE
if send(s, sendBuffer, len(sendBuffer), 0) = SOCKET_ERROR then
closesocket s
return "Sende-Fehler!"
end if
' Daten empfangen, bis die Verbindung geschlossen wird
dim recvbuffer as zstring * RECVBUFFLEN+1
dim bytes as integer
do
bytes = recv(s, recvBuffer, RECVBUFFLEN, 0)
ret &= string(bytes, 32)
for i as integer = 0 to bytes-1
ret[position+i] = recvbuffer[i]
next
position += bytes
loop until bytes <= 0
shutdown s, 2
closesocket s
return ret
end function
' Windows: Winsock starten
#ifdef __FB_WIN32__
dim wsaData as WSAData
if WSAStartup(MAKEWORD(1, 1), @wsaData) <> 0 then
print "Fehler: WSAStartup fehlgeschlagen" : end 1
end if
#endif
print httpGet("users.freebasic-portal.de", _
"nemored/buch2D/version")
' Windows: Winsock beenden
#ifdef __FB_WIN32__
WSACleanup
#endif