Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Quizprogramm
| Uploader: |  nemored |
| Datum/Zeit: | 26.07.2012 22:20:00 |
#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
ia.S_addr = inet_addr(hostname)
IF ia.S_addr = INADDR_NONE THEN
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
DIM ip AS INTEGER, position AS INTEGER = 0, s AS SOCKET
ip = resolveHost(hostname)
IF ip = 0 THEN RETURN "Ungueltige Adresse!"
s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
IF s = 0 THEN RETURN "Socket-Fehler!"
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
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
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
#IFDEF __FB_WIN32__
DIM wsaData AS WSAData
IF WSAStartup(MAKEWORD(1, 1), @wsaData) <> 0 THEN
PRINT "Fehler: WSAStartup fehlgeschlagen" : END 1
END IF
#ENDIF
' *** QUIZ-PROGRAMM ***
PRINT "Ergaenze die gefluegelten Worte. Um das Programm vorzeitig"
PRINT "abzubrechen, druecke RETURN, ohne zuvor etwas einzugeben."
DIM frage AS INTEGER = 1, such AS INTEGER, meldung AS STRING, antwort AS STRING
DO
PRINT
meldung = httpGet("programmierung.eulengesang.de", "raetsel.php?frage=" & frage)
such = INSTR(meldung, !"\r\n\r\n")
IF such > LEN(meldung) - 5 THEN
PRINT "Gratulation - du hast alle Fragen beantwortet!"
EXIT DO
END IF
PRINT "Ergaenze: "; MID(meldung, such+4)
INPUT "", antwort
DO
such = INSTR(antwort, " ")
IF such = 0 THEN EXIT DO
antwort = LEFT(antwort, such-1) & "%20" & MID(antwort, such+1)
LOOP
IF antwort = "" THEN EXIT DO
meldung = httpGet("programmierung.eulengesang.de", "raetsel.php?frage=" & frage _
& "&antwort=" & LCASE(antwort))
such = INSTR(meldung, !"\r\n\r\n")
IF MID(meldung, such+4) = "richtig" THEN
PRINT "Die Antwort ist richtig!"
frage += 1
ELSE
PRINT "Die Antwort war leider falsch. Versuche es noch einmal."
END IF
LOOP
' *** PROGRAMM-ENDE ***
#IFDEF __FB_WIN32__
WSACleanup
#ENDIF