Announcement

Collapse
No announcement yet.

Cant Compile With PBCC5.0

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Chris Holbrook
    replied
    Steve,
    I tried compiling and got the same result as you.

    Then I unloaded the webserver which I had forgotten to shut down and tried again, with success!

    By success I mean without the error message.

    Leave a comment:


  • Steve Bouffe
    replied
    Been digging around and have now added a line to display the Windows Sockets Error Code.

    The code returned is 10045

    Described as

    WSAEOPNOTSUPP

    Operation not supported.

    The attempted operation is not supported for the type of object referenced. Usually this occurs when a socket descriptor to a socket that cannot support this operation is trying to accept a connection on a datagram socket.

    Can anyone help here?
    Code:
    ' SED_PBCC
    'MESSAGE http://www.powerbasic.com/support/forums/Archives/Archive-000002/HTML/20000801-7-000085.html
    'FORUM:  Source Code
    'TOPIC:  Archive: Web Server in PBCC
    'NAME:   Erik Olson, Member
    'DATE:   October 17, 1998 08:45 AM
    ' PowerBASIC WEB SERVER APPLICATION
    ' Author: Erik Olson   [email protected]
    ' for more information refer to RFC 1945
    ' Compiled with PBCC 1.0
    ' Public Domain
    ' HOW TO RUN (must have TCP/IP installed)
    ' Create a web page.  Run PBHTTP from that directory.  Look at the page
    ' with your browser. There it is. If you are connected to the internet,
    ' then everyone else can see it too.  Use this source code to build
    ' really fast custom web applications.  Read the RFC's.
    '
    ' HOW IT WORKS (because you really want to know)
    ' This program sets up a socket host and then launches a thread called
    ' LISTENTHREAD.  This thread listens for connection requests on port 80
    ' (the standard web server port) and upon receiving a connection will
    ' spawn a thread to handle it.  The function spawned is SOCKETTHREAD
    ' which receives one line at a time from the web browser.  This initial
    ' data is the header which looks something like this:
    '
    '    GET /mypage.htm HTTP/1.0
    '    Connection: keep -Alive
    '     User-Agent: Mozilla/4.01 [en] [WinNT; I]
    '    Host: 204.96.208.229
    '
    '
    ' This is what the web browser actually sends to the web server.  The initial
    ' hit will probably be an HTML page.  If the page contains any references to
    ' other objects from the server (or any other server) such as .gif or .jpg
    ' images, the web browser will instantly (and simultaneously) attach concurrent
    ' connections to the server and ask for these items too.
    '
    ' The server opens the requested file and loads it into a string. It then
    ' gets the length and type of file to create a header to send back that
    ' looks like this:
    '
    '    HTTP/1.0 200 OK
    '    Server: PBHTTP 1.0
    '    Content-Type: text/html
    '    Accept-Ranges: bytes
    '    Content-Length: 3423
    '
    ' This header is followed by an exact binary image of the file (be it a web
    ' page or gif image).  Throw in a little error trapping, a few bells and
    ' whistles, and there you have yourself a web server!
    '
    ' Finally, MONITORTHREAD wakes up every 10 seconds and checks to see if
    ' any threads are more than 20 seconds old (stuck).  If they are, it issues a
    ' STOP command to the thread.  During the next 10 second wake-up, it will
    ' see that the thread has responded to the stop command and will issue
    ' a KILL command to the thread to delete it from memory.  A thread that
    ' has not been STOPped cannot be KILLed.  (see the commands PS,STOP, and
    ' KILL)
    ' The main body of the program displays a command prompt and accepts
    ' commands.  This command shell will be used to control the server.  Right
    ' now the only commands it supports are as follows:
    '    QUIT - stops the server
    '    PS - (ProcesS) lists all active threads, run times, and modes
    '    ECHO ON, ECHO OFF, ECHO - turns on and off quiet mode, or shows mode
    '    STOP <thread> tells thread to stop
    '   KILL <thread> deletes a stopped thread from memory
    '   MON <thread> monitors the i/o on a thread's socket
    '
    ' more commands can be added to kill threads, move files, etc.
    '
    ' Web Server Features (existing, and the kind you might want):
    ' - defaults to default.htm if no page specified.
    ' - Supports html, gif, jpeg. all other types considered binary files.  Browser will download them.
    ' - Error checking (some exists, and an error page is returned to the browser)
    ' - CGI (not implemented. Shell to DOS and execute an .exe, then echo back the output)
    ' - Display a directory if no default.htm exists.  (not implemented)
    ' potential enhancements
    ' - Add your own html extensions for server side commands and functions, or database support
    '   (simplifies the creation of CGI scripts, speeds up server response time)
    ' - Recompile under pbdll for a graphical server interface
    ' - Use this code as the starting point for your own proxy server or BBS-internet interface
    '   (client asks server for page.  this program connects to a remote server and gets the page,
    '    then echoes it back to the client.)
    '
    '
    ' LIMITATIONS
    ' supports up to 9999 concurrent threads
    ' A thread can survive for no more than 20 seconds.  After that, it is
    ' terminated by the function MONITORTHREAD.  20 seconds is more than
    ' sufficient for retrieving a hypertext document or graphic.
    ' this server currently will not retrieve any objects larger than 62000 bytes.
    ' this limit is easily overcome by increasing the size of the string variable
    ' buf in SOCKETTHREAD
    ' WARNING: the logic used to calculate the age of a thread will not operate
    ' properly if the thread was created before midnight, and it exists into the
    ' new day.  MONITORTHREAD will see it as a negative run time and will not
    ' terminate the thread.  This will have the effect of eventually building up
    ' unterminated threads over time.  These threads can be manually STOPped and
    ' KILLed using the PS, STOP, and KILL commands.
    ' All output is terminated with a Carriage-return/line feed pair. I set it up
    ' to check for what kind of line termination a client was using, and to use
    ' that kind in return, but http transmits a CRLF and wants a CRLF, so I just
    ' made it all CRLF.
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    $INCLUDE "WIN32API.INC"
    $INCLUDE "WSOCK32.INC"
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    %PORTNUM = 80
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    DECLARE FUNCTION SocketThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION TimeFile$
    DECLARE FUNCTION CrLf$( hSocket AS LONG )
    DECLARE SUB WriteErrorPage
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION PBMAIN
    	DIM result AS WORD
    	DIM wDat AS WSADATA
    	DIM Sockin AS SOCKADDR_IN
    	DIM s AS LONG
    	DIM ns AS LONG
    	DIM pid AS LONG
    	GLOBAL flags AS LONG
    	GLOBAL NumberOfThreads AS INTEGER
    	GLOBAL BADCHARS AS STRING
    	GLOBAL Quiet AS INTEGER		' if true shuts up threads from announcing status
    	DIM Buf AS ASCIIZ * 512
    	DIM IdThread( 9999 ) AS GLOBAL LONG		'array to store thread handles
    	DIM TimeThread( 9999 ) AS GLOBAL LONG		' array to store start time of thread
    	DIM CRLFThread( 9999 ) AS GLOBAL BYTE		' array to store thread output characteristics
    	DIM Mon AS GLOBAL INTEGER
    	DIM n&
    	BADCHARS = CHR$( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 )
    	result = WSASTARTUP( 257, wdat )
    	STDOUT "PBHTTP : Web Server application version 1.0"
    	STDOUT "Written by Erik Olson, Clearwater, Florida"
    	STDOUT "Press Control-Break or type QUIT to terminate server."
    	DIM Title AS ASCIIZ * 80
    	Title = "PowerBASIC HTTP Server"
    	SETCONSOLETITLE( Title )
    	Dummy& = 0
    	THREAD CREATE ListenThread( Dummy& ) TO hLISTEN&
    	THREAD CREATE MonitorThread( Dummy& ) TO hMONITOR&
    	SLEEP 2000		' give threads a chance to start
    	DO
    		STDOUT $CRLF + "Command:";		' display a prompt
    		STDIN LINE a$		' ...............................get input from keyboard
    		Mon = 0		'...................set monitoring to 0 always after any input
    		STDOUT $CRLF;		' ....print a carriage return after keyboard input
    		a$ = UCASE$( LTRIM$( RTRIM$( a$ )))		' ................upper case the input
    		IF a$ = "" THEN
    			ITERATE DO		'.........................go to top of loop if no input
    		END IF
    		IF INSTR( a$, " " ) > 1 THEN		'...................if line has a space then
    			Cmd$ = LEFT$( a$, INSTR( a$, " " ) - 1 )		'.....separate out the first word
    			Arg$ = MID$( a$, INSTR( a$, " " ) + 1 )		'........from the rest of the line
    		ELSE
    			Cmd$ = a$		'...........................otherwise it's just one word
    		END IF
    		SELECT CASE Cmd$		'...................execute the command you just typed
    			CASE "STOP"
    				n& = VAL( "&H" + Arg$ )
    				IF TIMEThread( n& ) = - 1 THEN
    					STDOUT $CRLF + "Thread is stopped" + $CRLF
    				ELSEIF TIMEThread( n& ) = 99999 THEN
    					STDOUT $CRLF + "Thread is dying" + $CRLF
    				ELSEIF TIMEThread( n& ) = 0 THEN
    					STDOUT $CRLF + "Thread does not exist" + $CRLF
    				ELSE
    					TIMEThread( n& ) = - 1
    				END IF
    			CASE "KILL"
    				n& = VAL( "&H" + Arg$ )
    				IF TIMEThread( n& ) = - 1 THEN
    					STDOUT $CRLF + "Thread still running" + $CRLF
    				ELSEIF TIMEThread( n& ) = 99999 THEN
    					STDOUT $CRLF + "Killing thread, result =";
    					THREAD CLOSE idThread( n& ) TO r&
    					STDOUT STR$( r& ) + $CRLF
    					IF r& = - 1 THEN
    						idThread( n& ) = 0
    						TIMEThread( n& ) = 0
    						CRLFThread( n& ) = 0
    					END IF
    				ELSEIF TIMEThread( n& ) = 0 THEN
    					STDOUT $CRLF + "Thread does not exist" + $CRLF
    				ELSE
    					STDOUT $CRLF + "Thread has not been told to stop" + $CRLF
    				END IF
    			CASE "MON"
    				Mon = VAL( "&H" + Arg$ )		'..........................monitor this thread
    			CASE "QUIT"
    				EXIT SELECT
    			CASE "ECHO"
    				IF Arg$ = "ON" THEN		'.arg$ is what comes after the first space
    					Quiet = 0
    				ELSEIF Arg$ = "OFF" THEN
    					Quiet = - 1
    				ELSE
    					STDOUT "ECHO IS ";		'.....if no ON or OFF then show status
    					IF Quiet THEN STDOUT "OFF" ELSE STDOUT "ON"
    				END IF
    			CASE "PS"
    				sts& = 0
    				THREAD STATUS hListen& TO sts&
    				STDOUT "Listen Thread status " + HEX$( sts& )
    				THREAD STATUS hTransmit& TO sts&
    				STDOUT "Transmit Thread status " + HEX$( sts& )
    				THREAD STATUS hMonitor& TO sts&
    				STDOUT "Monitor Thread status " + HEX$( sts& )
    				FOR y% = 1 TO 9999
    					IF idThread( y% ) THEN
    						sts& = 0
    						THREAD STATUS idThread( y% ) TO sts&
    						STDOUT "Thread " + HEX$( y% );
    						STDOUT " status " + HEX$( sts& );
    						IF TIMEThread( y% ) = - 1 THEN
    							STDOUT " STOPPED";
    						ELSEIF TIMEThread( y% ) = 99999 THEN
    							STDOUT " DEAD ";
    						ELSE
    							STDOUT " Runtime " + STR$( TIMER - timethread( y% ));
    						END IF
    						STDOUT " newline " + STR$( CRLFThread( y% ))
    					END IF
    				NEXT y%
    			CASE ELSE		'........................an unknown command was entered
    				STDOUT "Unknown Command - " + Cmd$ + $CRLF
    				' of course, we could shell to DOS (console) whatever command
    				' was typed (like DIR or COPY or MKDIR) and since this is a
    				' multithreaded app it would not interrupt the server.  Cool.
    				' if this is NT
    				'    SHELL environ$("SYSTEM_ROOT")+"\system32\cmd.exe /c " + a$
    				' else
    				'   SHELL \COMMAND.COM /c " + a$
    				' endif
    		END SELECT
    		IF Cmd$ = "QUIT" THEN
    			EXIT LOOP
    		END IF
    	LOOP
    END FUNCTION		' terminates all threads
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION SocketThread( BYVAL hsocket AS LONG ) AS LONG
    	' This is a distinct thread for each client
    	' this function receives data and writes it
    	' into the IN directory
    	DIM Buf AS ASCIIZ * 62000
    	DIM pBuf AS ASCIIZ PTR
    	DIM ThisThread AS INTEGER
    	DIM Finished AS INTEGER
    	DIM FF AS INTEGER
    	DIM EC AS LONG
    	IF NOT quiet THEN
    		STDOUT $CRLF + "Thread " + HEX$( hsocket ) + " Created." + $CRLF
    	END IF
    	cmd& = %FIONBIO
    	argp& = 1
    	n& = IOCTLSOCKET( hSocket, cmd&, argp& )
    	'
    	IF n& = - 1 THEN
    		EC = WSAGETLASTERROR
    		STDOUT "IOCTL error" + STR$( EC )
    		STDOUT $DQ + WSAGetLastErrorMsg( EC ) + $DQ
    		CLOSESOCKET hSocket
    		EXIT FUNCTION
    	END IF
    	DO UNTIL TIMEThread( hSocket ) < 0
    		SLEEP 1		'release CPU time
    		i% = RRECV( hSocket, buf, SIZEOF( buf ), 0 )
    		IF i% > 0 THEN
    			a$ = LEFT$( buf, i% )
    			IF INSTR( a$, CHR$( 4 )) THEN
    				EXIT LOOP
    			END IF
    		ELSE
    			a$ = ""
    		END IF
    		IF LEN( a$ ) > 0 THEN
    			TIMEThread( hSocket ) = TIMER
    			' Add input data to buffer
    			a$ = REMOVE$( a$, ANY BADCHARS )
    			REPLACE $CRLF WITH $CR IN a$		' filter out crlf pairs, make them cr
    			InBuffer$ = InBuffer$ + a$
    			DO WHILE INSTR( InBuffer$, $CR )
    				SLEEP 1		'release CPU time
    				InBuffer$ = REMOVE$( InBuffer$, ANY BADCHARS )
    				Cmd$ = LEFT$( InBuffer$, INSTR( InBuffer$, $CR ) - 1 )
    				InBuffer$ = MID$( InBuffer$, INSTR( InBuffer$, $CR ) + 1 )
    				IF NOT Quiet THEN
    					STDOUT "[" + Cmd$ + "]"
    				END IF
    				IF LEFT$( Cmd$, 3 ) = "GET" THEN		'..................................GET an object by name
    					fi$ = MID$( Cmd$, 5 )		'...............GET /page.htm HTTP/1.x
    					IF INSTR( Cmd$, " " ) THEN
    						fi$ = LEFT$( fi$, INSTR( fi$, " " ) - 1 )
    					END IF
    					fi$ = LTRIM$( RTRIM$( fi$ ))
    					IF fi$ = "/" OR fi$ = "\" OR fi$ = "" THEN fi$ = "default.htm"
    					REPLACE "/" WITH "\" IN fi$		' ........................change unix style slashes
    					IF LEFT$( fi$, 1 ) = "\" THEN fi$ = MID$( fi$, 2 )		' .............use current dir as root
    					IF RIGHT$( fi$, 1 ) = "\" THEN fi$ = fi$ + "default.htm"
    					STDOUT "requested " + fi$
    					' Should actually do real http error headers here, but this is good enough
    					' if page is not found then use "error.htm" as custom error msg.  Create if not exist
    					IF INSTR( fi$, "." ) = 0 THEN
    						fi$ = fi$ + ".htm"
    					END IF		'.........................default to .htm extension (how nice!)
    					IF DIR$( fi$ ) = "" THEN fi$ = "error.htm" : IF DIR$( "error.htm" ) = "" THEN WriteErrorPage
    					STDOUT "sending " + fi$
    					' establish filename for data type.  All files are binary files (even html files)
    					ext_var$ = MID$( fi$, INSTR( fi$, "." ) + 1 )
    					SELECT CASE LCASE$( ext_var$ )
    						CASE "htm", "html"
    							Content$ = "text/html"
    						CASE "jpg", "jpeg"
    							Content$ = "image/jpeg"
    						CASE "gif"
    							Content$ = "image/gif"
    						CASE "exe", "com", "bat", "cgi", "cmd", "bin"
    							Content$ = "text/html"		' CGI support (not done)
    							' need to shell fi$ with < stdin > stdout and echo back output
    							SHELL fi$ + " > temp.htm"		' a kludge for testing
    							fi$ = "temp.htm"		' show output of shell cmd
    						CASE ELSE
    							Content$ = "application/octet-stream"
    					END SELECT
    					STDOUT ext_var$ + " is " + Content$
    				END IF
    				IF Cmd$ = "" THEN		'.............CRLF on a line by itself    indicates header is over
    					ff = FREEFILE
    					OPEN fi$ FOR BINARY SHARED AS #ff		'..........read the page from disk into HTML$
    					GET$ #ff, LOF( FF ), HTML$
    					CLOSE #ff
    					'HTML$ = Process$(HTML$) '............... Do any custom stuff to the web page
    					' ...................................... create the header for this page
    					HEADER$ = "HTTP/1.0 200 OK" + CrLf$( hSocket )
    					HEADER$ = HEADER$ + "Server: PBHTTP 1.0" + CrLf$( hSocket )
    					HEADER$ = HEADER$ + "Content-Type: " + Content$ + CrLf$( hSocket )
    					HEADER$ = HEADER$ + "Accept-Ranges: bytes" + CrLf( hSocket )
    					HEADER$ = HEADER$ + "Content-Length: " + LTRIM$( STR$( LEN( HTML$ ))) + CrLf$( hSocket )
    					HEADER$ = HEADER$ + CrLf$( hSocket )
    					' Show Time ! ! !
    					TIMEThread( hSocket ) = TIMER		'...............update activity timer
    					buf = HEADER$ + HTML$
    					IF LEN( Buf ) > 0 THEN
    						IF SSEND( hSocket, buf, LEN( HEADER$ ) + LEN( HTML$ ), flags ) = - 1 THEN
    							STDOUT "Send Error on socket " + HEX$( hSocket ) + $CRLF
    						END IF
    						IF Mon = hSocket THEN		'.............monitor activity on a thread
    							STDOUT Buf
    							STDOUT $CRLF
    						END IF
    					END IF
    					finished = - 1
    					EXIT LOOP
    				END IF
    			LOOP
    		END IF
    	LOOP WHILE NOT finished
    	'Sleep 2000
    	CLOSESOCKET hSocket
    	STDOUT $CRLF + "Thread (" + LTRIM$( STR$( ThisThread )) + ") ended.==================="
    	TIMEThread( hSocket ) = 99999		' tell monitorthread to kill us
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    SUB Sprint( hSocket AS LONG, Txt AS STRING )
    	DIM buf AS ASCIIZ * 512
    	Buf = Txt
    	i% = SSEND( hSocket, Buf, LEN( Buf ), flags )
    END SUB
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION TimeFile$
    	' create a unique file name
    	' number of seconds past midnight (to the tenth of a second)
    	' and then a random letter.
    	' 8 letters
    	' no extension
    	RANDOMIZE TIMER
    	FUNCTION = CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 ) + _
    	  CHR$( INT( RND( 1 ) * 25 ) + 65 )
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION CrLf$( hSocket AS LONG )
    	' can be used to select end-of-line character based on socket used
    	FUNCTION = $CRLF
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    	' this is a single thread that operates independantly
    	' this thread listens for client connection requests
    	' and spawns SOCKETTHREAD for each client.
    	'
    	DIM result AS WORD
    	DIM wDat AS WSADATA
    	DIM Sockin AS SOCKADDR_IN
    	DIM s AS LONG
    	DIM ns AS LONG
    	DIM pid AS LONG
    	DIM Buf AS ASCIIZ * 512
    	DIM FF AS INTEGER
    	STDOUT "Listen Thread Active" + $CRLF
    	' Create a socket
    	s = SOCKET( %PF_INET, %SOCK_STREAM, %IPPROTO_TCP )
    	IF s = - 1 THEN
    		STDOUT "create socket error"
    		EXIT FUNCTION
    	END IF
    	sockin.sin_family = %AF_INET
    	sockin.sin_port = HTONS( %PORTNUM )
    	sockin.sin_addr.s = CHR$( 0, 0, 0, 0 )		'''''htonl(%INADDR_ANY)
    	n& = BIND( s, Sockin, SIZEOF( Sockin ))
    	IF n& = - 1 THEN
    		STDOUT "BIND Error"
    		CLOSESOCKET S
    		WSACLEANUP
    		EXIT FUNCTION
    	END IF
    	n& = LISTEN( s, 5 )
    	IF n& = - 1 THEN
    		STDOUT "LISTEN Error"
    		CLOSESOCKET S
    		WSACLEANUP
    		EXIT FUNCTION
    	END IF
    	DO
    		ns = AACCEPT( s, Sockin, SIZEOF( Sockin ))
    		IF ns = - 1 THEN
    			STDOUT "ACCEPT Error"
    			CLOSESOCKET S
    			WSACLEANUP
    			EXIT FUNCTION
    		END IF
    		THREAD CREATE SocketThread( ns ) TO idthread( ns )
    		timethread( ns ) = TIMER
    	LOOP
    	' stop winsock
    	CLOSESOCKET S
    	WSACLEANUP
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    	' every 10 seconds, check all of the threads.  if any are
    	' over 60 seconds old, tell them to die.  If any threads
    	' have responded to the death instruction, close them.
    	SLEEP 500
    	DIM R&
    	DIM y%
    	STDOUT "Monitor Thread Active" + $CRLF
    	DO
    		SLEEP 10000
    		FOR y% = 1 TO 9999
    			IF idThread( y% ) THEN
    				sts& = 0
    				THREAD STATUS idThread( y% ) TO sts&
    				IF TIMEThread( y% ) = - 1 THEN
    					' thread has been told to die
    				ELSEIF TIMEThread( y% ) = 99999 THEN		' close the dead thread
    					SLEEP 1000
    					THREAD CLOSE idThread( y% ) TO r&
    					IF NOT quiet THEN
    						STDOUT "Closed thread " + HEX$( y% ) + " result = " + STR$( r& )
    					END IF
    					TIMEThread( y% ) = 0
    					CRLFThread( y% ) = 0
    					idThread( y% ) = 0
    				ELSE
    					IF TIMER - timethread( y% ) > 15 THEN
    						TIMEThread( y% ) = - 1
    					END IF
    				END IF
    			END IF
    		NEXT y%
    	LOOP
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    SUB WriteErrorPage
    	DIM ff AS INTEGER
    	ff = FREEFILE
    	OPEN "Error.htm" FOR OUTPUT AS #ff
    	PRINT #ff, "<HTML><HEAD><TITLE>PBHTTP ERROR</TITLE></HEAD><BODY>URL NOT FOUND!</BODY></HTML>"
    	CLOSE #ff
    END SUB
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION Process_Function$( HTML$ )
    	' do anything to the web page that floats your boat before sending it.  Invent your own
    	' server side script language, for example.
    	FUNCTION = HTML$
    END FUNCTION
    
    
    
    '----------------------------------------------------------------------------(')
    
    
    
    FUNCTION WSAGetLastErrorMsg( WSAError AS LONG ) AS STRING
    	SELECT CASE WSAError
    			' Windows Sockets definitions of regular Microsoft C error constants
    		CASE %WSAEINTR : FUNCTION = "Interrupted system call."
    		CASE %WSAEBADF : FUNCTION = "Bad file number."
    		CASE %WSAEACCES : FUNCTION = "Permission Denied."
    		CASE %WSAEFAULT : FUNCTION = "Bad Address."
    		CASE %WSAEINVAL : FUNCTION = "Invalid Argument."
    		CASE %WSAEMFILE : FUNCTION = "Too many open files."
    			' Windows Sockets definitions of regular Berkeley error constants
    		CASE %WSAEWOULDBLOCK : FUNCTION = "Operation would block."
    		CASE %WSAEINPROGRESS : FUNCTION = "Operation now in progress."
    		CASE %WSAEALREADY : FUNCTION = "Operation already in progress."
    		CASE %WSAENOTSOCK : FUNCTION = "Socket operation on nonsocket."
    		CASE %WSAEDESTADDRREQ : FUNCTION = "Destination address required."
    		CASE %WSAEMSGSIZE : FUNCTION = "Message too long."
    		CASE %WSAEPROTOTYPE : FUNCTION = "Protocol wrong type for socket."
    		CASE %WSAENOPROTOOPT : FUNCTION = "Protocol not available."
    		CASE %WSAEPROTONOSUPPORT : FUNCTION = "Protocol not supported."
    		CASE %WSAESOCKTNOSUPPORT : FUNCTION = "Socket type not supported."
    		CASE %WSAEOPNOTSUPP : FUNCTION = "Operation not supported on socket."
    		CASE %WSAEPFNOSUPPORT : FUNCTION = "Protocol family not supported."
    		CASE %WSAEAFNOSUPPORT : FUNCTION = "Address family not supported by protocol family."
    		CASE %WSAEADDRINUSE : FUNCTION = "Address already in use."
    		CASE %WSAEADDRNOTAVAIL : FUNCTION = "Can't assign requested address."
    		CASE %WSAENETDOWN : FUNCTION = "Network is down."
    		CASE %WSAENETUNREACH : FUNCTION = "Network is unreachable."
    		CASE %WSAENETRESET : FUNCTION = "Network dropped connection."
    		CASE %WSAECONNABORTED : FUNCTION = "Software caused connection abort."
    		CASE %WSAECONNRESET : FUNCTION = "Connection reset by peer."
    		CASE %WSAENOBUFS : FUNCTION = "No buffer space available."
    		CASE %WSAEISCONN : FUNCTION = "Socket is already connected."
    		CASE %WSAENOTCONN : FUNCTION = "Socket is not connected."
    		CASE %WSAESHUTDOWN : FUNCTION = "Can't send after socket shutdown."
    		CASE %WSAETOOMANYREFS : FUNCTION = "Too many references: can't splice."
    		CASE %WSAETIMEDOUT : FUNCTION = "Connection timed out."
    		CASE %WSAECONNREFUSED : FUNCTION = "Connection refused."
    		CASE %WSAELOOP : FUNCTION = "Too many levels of symbolic links."
    		CASE %WSAENAMETOOLONG : FUNCTION = "File name too long."
    		CASE %WSAEHOSTDOWN : FUNCTION = "Host is down."
    		CASE %WSAEHOSTUNREACH : FUNCTION = "No route to host."
    		CASE %WSAENOTEMPTY : FUNCTION = "Directory not empty."
    		CASE %WSAEPROCLIM : FUNCTION = "Too many processes."
    		CASE %WSAEUSERS : FUNCTION = "Too many users."
    		CASE %WSAEDQUOT : FUNCTION = "Disk quota exceeded."
    		CASE %WSAESTALE : FUNCTION = "Stale NFS file handle."
    		CASE %WSAEREMOTE : FUNCTION = "Too many levels of remote in path."
    			' Extended Windows Sockets errors
    		CASE %WSASYSNOTREADY : FUNCTION = "Network subsystem is unusable."
    		CASE %WSAVERNOTSUPPORTED : FUNCTION = "Winsock DLL cannot support this application."
    		CASE %WSANOTINITIALISED : FUNCTION = "Winsock not initialized."
    		CASE %WSAEDISCON : FUNCTION = "Disconnect."
    		CASE %WSAENOMORE : FUNCTION = "Nonrecoverable error."
    		CASE %WSAECANCELLED : FUNCTION = "Valid name, no data record of requested type."
    		CASE %WSAEINVALIDPROCTABLE : FUNCTION = "Invalid proc table."
    		CASE %WSAEINVALIDPROVIDER : FUNCTION = "Invalid provider."
    		CASE %WSAEPROVIDERFAILEDINIT : FUNCTION = "Provider failed init."
    		CASE %WSASYSCALLFAILURE : FUNCTION = "Sys call failure."
    		CASE %WSASERVICE_NOT_FOUND : FUNCTION = "Service not found."
    		CASE %WSATYPE_NOT_FOUND : FUNCTION = "Type not found."
    		CASE %WSA_E_NO_MORE : FUNCTION = "E no more."
    		CASE %WSA_E_CANCELLED : FUNCTION = "Error cancelled."
    		CASE %WSAEREFUSED : FUNCTION = "Error refused."
    			' Error return codes from gethostbyname() and gethostbyaddr()
    		CASE %WSAHOST_NOT_FOUND : FUNCTION = "Host not found."
    		CASE %WSATRY_AGAIN : FUNCTION = "Nonauthoritative host not found or serverfail"
    		CASE %WSANO_RECOVERY : FUNCTION = "Non-recoverable errors, formerr, refused, notimp."
    		CASE %WSANO_DATA : FUNCTION = "Valid name, no data record of requested type."
    		CASE ELSE : FUNCTION = "Error:" & STR$( WSAError ) & "."
    	END SELECT
    END FUNCTION
    Last edited by Steve Bouffe; 5 Jan 2010, 05:40 PM.

    Leave a comment:


  • Steve Bouffe
    replied
    Program compiles and runs fine. When I cann the IP address the program responds with IOCTL error

    Leave a comment:


  • José Roca
    replied
    For a variable dimed as an structure, LEN and SIZEOF will return the same value.

    Leave a comment:


  • colin glenn
    replied
    Try using:
    Code:
    n& = bind( s, Sockin, [B]LEN[/B]( Sockin ))
    instead of
    Code:
    n& = bind( s, Sockin, SIZEOF( Sockin ))

    Leave a comment:


  • Steve Bouffe
    replied
    I still have my copy of PBCC2.0 and the program runs as expected. However can not run under anything higher, tried 3.0 to current version 5.02

    Hope someone can help out

    Leave a comment:


  • Steve Bouffe
    replied
    Thanks for the fast response. Changed them and compiles now. When I run I get message "bind error"

    Code:
    ' SED_PBCC
    'MESSAGE http://www.powerbasic.com/support/forums/Archives/Archive-000002/HTML/20000801-7-000085.html
    'FORUM:  Source Code
    'TOPIC:  Archive: Web Server in PBCC
    'NAME:   Erik Olson, Member
    'DATE:   October 17, 1998 08:45 AM
    
    ' PowerBASIC WEB SERVER APPLICATION
    ' Author: Erik Olson   [email protected]
    ' for more information refer to RFC 1945
    ' Compiled with PBCC 1.0
    ' Public Domain
    
    ' HOW TO RUN (must have TCP/IP installed)
    ' Create a web page.  Run PBHTTP from that directory.  Look at the page
    ' with your browser. There it is. If you are connected to the internet,
    ' then everyone else can see it too.  Use this source code to build
    ' really fast custom web applications.  Read the RFC's.
    '
    ' HOW IT WORKS (because you really want to know)
    ' This program sets up a socket host and then launches a thread called
    ' LISTENTHREAD.  This thread listens for connection requests on port 80
    ' (the standard web server port) and upon receiving a connection will
    ' spawn a thread to handle it.  The function spawned is SOCKETTHREAD
    ' which receives one line at a time from the web browser.  This initial
    ' data is the header which looks something like this:
    '
    '    GET /mypage.htm HTTP/1.0
    '    Connection: keep -Alive
    '     User-Agent: Mozilla/4.01 [en] [WinNT; I]
    '    Host: 204.96.208.229
    '
    '
    ' This is what the web browser actually sends to the web server.  The initial
    ' hit will probably be an HTML page.  If the page contains any references to
    ' other objects from the server (or any other server) such as .gif or .jpg
    ' images, the web browser will instantly (and simultaneously) attach concurrent
    ' connections to the server and ask for these items too.
    '
    ' The server opens the requested file and loads it into a string. It then
    ' gets the length and type of file to create a header to send back that
    ' looks like this:
    '
    '    HTTP/1.0 200 OK
    '    Server: PBHTTP 1.0
    '    Content-Type: text/html
    '    Accept-Ranges: bytes
    '    Content-Length: 3423
    '
    ' This header is followed by an exact binary image of the file (be it a web
    ' page or gif image).  Throw in a little error trapping, a few bells and
    ' whistles, and there you have yourself a web server!
    '
    ' Finally, MONITORTHREAD wakes up every 10 seconds and checks to see if
    ' any threads are more than 20 seconds old (stuck).  If they are, it issues a
    ' STOP command to the thread.  During the next 10 second wake-up, it will
    ' see that the thread has responded to the stop command and will issue
    ' a KILL command to the thread to delete it from memory.  A thread that
    ' has not been STOPped cannot be KILLed.  (see the commands PS,STOP, and
    ' KILL)
    
    ' The main body of the program displays a command prompt and accepts
    ' commands.  This command shell will be used to control the server.  Right
    ' now the only commands it supports are as follows:
    '    QUIT - stops the server
    '    PS - (ProcesS) lists all active threads, run times, and modes
    '    ECHO ON, ECHO OFF, ECHO - turns on and off quiet mode, or shows mode
    '    STOP <thread> tells thread to stop
    '   KILL <thread> deletes a stopped thread from memory
    '   MON <thread> monitors the i/o on a thread's socket
    '
    ' more commands can be added to kill threads, move files, etc.
    '
    ' Web Server Features (existing, and the kind you might want):
    ' - defaults to default.htm if no page specified.
    ' - Supports html, gif, jpeg. all other types considered binary files.  Browser will download them.
    ' - Error checking (some exists, and an error page is returned to the browser)
    ' - CGI (not implemented. Shell to DOS and execute an .exe, then echo back the output)
    ' - Display a directory if no default.htm exists.  (not implemented)
    
    ' potential enhancements
    ' - Add your own html extensions for server side commands and functions, or database support
    '   (simplifies the creation of CGI scripts, speeds up server response time)
    ' - Recompile under pbdll for a graphical server interface
    ' - Use this code as the starting point for your own proxy server or BBS-internet interface
    '   (client asks server for page.  this program connects to a remote server and gets the page,
    '    then echoes it back to the client.)
    '
    '
    ' LIMITATIONS
    
    ' supports up to 9999 concurrent threads
    
    ' A thread can survive for no more than 20 seconds.  After that, it is
    ' terminated by the function MONITORTHREAD.  20 seconds is more than
    ' sufficient for retrieving a hypertext document or graphic.
    
    ' this server currently will not retrieve any objects larger than 62000 bytes.
    ' this limit is easily overcome by increasing the size of the string variable
    ' buf in SOCKETTHREAD
    
    ' WARNING: the logic used to calculate the age of a thread will not operate
    ' properly if the thread was created before midnight, and it exists into the
    ' new day.  MONITORTHREAD will see it as a negative run time and will not
    ' terminate the thread.  This will have the effect of eventually building up
    ' unterminated threads over time.  These threads can be manually STOPped and
    ' KILLed using the PS, STOP, and KILL commands.
    
    ' All output is terminated with a Carriage-return/line feed pair. I set it up
    ' to check for what kind of line termination a client was using, and to use
    ' that kind in return, but http transmits a CRLF and wants a CRLF, so I just
    ' made it all CRLF.
    
    $INCLUDE "WIN32API.INC"
    $INCLUDE "WSOCK32.INC"
    
    %PORTNUM = 80
    
    DECLARE FUNCTION SocketThread ( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION TimeFile$
    DECLARE FUNCTION CrLf$(hSocket as LONG)
    DECLARE SUB WriteErrorPage
    
    FUNCTION pbmain
      DIM result AS WORD
      DIM wDat AS WSAdata
      DIM Sockin AS Sockaddr_in
      DIM s AS LONG
      DIM ns AS LONG
      DIM pid AS LONG
      GLOBAL flags as long
      GLOBAL NumberOfThreads AS INTEGER
      GLOBAL BADCHARS AS STRING
      GLOBAL Quiet AS INTEGER ' if true shuts up threads from announcing status
      DIM Buf AS ASCIIZ * 512
      DIM IdThread(9999) AS GLOBAL LONG 'array to store thread handles
      DIM TimeThread(9999) AS GLOBAL LONG ' array to store start time of thread
      DIM CRLFThread(9999) AS GLOBAL BYTE ' array to store thread output characteristics
      DIM Mon AS GLOBAL INTEGER
      DIM n&
      BADCHARS = CHR$( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 )
      result = WsaStartup( 257, wdat )
      stdout "PBHTTP : Web Server application version 1.0"
      stdout "Written by Erik Olson, Clearwater, Florida"
      stdout "Press Control-Break or type QUIT to terminate server."
      DIM Title AS ASCIIZ * 80
      Title = "PowerBASIC HTTP Server"
      SetConsoleTitle( Title )
      Dummy& = 0
      THREAD CREATE ListenThread( Dummy& ) to hLISTEN&
      THREAD CREATE MonitorThread( Dummy& ) to hMONITOR&
      sleep 2000 ' give threads a chance to start
    
      do
        stdout chr$(13,10)+"Command:"; ' display a prompt
          stdin line a$ ' ...............................get input from keyboard
        Mon = 0 '...................set monitoring to 0 always after any input
        stdout chr$(13,10); ' ....print a carriage return after keyboard input
        a$ = ucase$(ltrim$(rtrim$(a$))) ' ................upper case the input
        if a$ = "" then
            iterate do '.........................go to top of loop if no input
        end if
        if instr(a$," ") > 1 then '...................if line has a space then
            Cmd$ = left$(a$,instr(a$," ")-1) '.....separate out the first word
            Arg$ = mid$(a$,instr(a$," ")+1) '........from the rest of the line
        else
            Cmd$ = a$ '...........................otherwise it's just one word
        end if
        select case Cmd$'...................execute the command you just typed
            case "STOP"
                n& = val("&H" + Arg$)
                if TIMEThread(n&) = -1 then
                    stdout chr$(13,10)+"Thread is stopped"+chr$(13,10)
                elseif TIMEThread(n&) = 99999 then
                    stdout chr$(13,10)+"Thread is dying"+chr$(13,10)
                elseif TIMEThread(n&)=0 then
                    stdout chr$(13,10)+"Thread does not exist"+chr$(13,10)
                else
                    TIMEThread(n&)=-1
                end if
    
            case "KILL"
                n& = val("&H" + Arg$)
                if TIMEThread(n&) = -1 then
                    stdout chr$(13,10)+"Thread still running"+chr$(13,10)
                elseif TIMEThread(n&) = 99999 then
                    stdout chr$(13,10)+"Killing thread, result =";
                    THREAD CLOSE idThread(n&) TO r&
                    stdout str$(r&)+chr$(13,10)
                    if r& = -1 then
                        idThread(n&)=0
                        TIMEThread(n&)=0
                        CRLFThread(n&)=0
                    end if
                elseif TIMEThread(n&)=0 then
                    stdout chr$(13,10)+"Thread does not exist"+chr$(13,10)
                else
                    stdout chr$(13,10)+"Thread has not been told to stop"+chr$(13,10)
                end if
    
            case "MON"
                Mon = val("&H"+Arg$) '..........................monitor this thread
            case "QUIT"
                exit select
            case "ECHO"
                if Arg$ = "ON" then '.arg$ is what comes after the first space
                    Quiet = 0
                elseif Arg$ = "OFF" then
                    Quiet = -1
                else
                    STDOUT "ECHO IS "; '.....if no ON or OFF then show status
                    if Quiet then STDOUT "OFF" else STDOUT "ON"
                end if
            case "PS"
                sts& = 0
                THREAD STATUS hListen& TO sts&
                STDOUT "Listen Thread status " + hex$(sts&)
                THREAD STATUS hTransmit& TO sts&
                STDOUT "Transmit Thread status " + hex$(sts&)
                THREAD STATUS hMonitor& TO sts&
                STDOUT "Monitor Thread status " + hex$(sts&)
    
                for y% = 1 to 9999
                    if idThread(y%) then
                        sts& = 0
                        THREAD STATUS idThread(y%) TO sts&
                        STDOUT "Thread " + hex$(y%) ;
                        STDOUT " status " + hex$(sts&) ;
                        if TIMEThread(y%)=-1 then
                            STDOUT " STOPPED";
                        elseif TIMEThread(y%) = 99999 then
                            STDOUT " DEAD ";
                        else
                            STDOUT " Runtime " + str$(timer - timethread(y%)) ;
                        end if
                        STDOUT " newline " + str$(CRLFThread(y%))
                    end if
                next y%
            case else '........................an unknown command was entered
                stdout "Unknown Command - " + Cmd$ + chr$(13,10)
                ' of course, we could shell to DOS (console) whatever command
                ' was typed (like DIR or COPY or MKDIR) and since this is a
                ' multithreaded app it would not interrupt the server.  Cool.
                ' if this is NT
                '    SHELL environ$("SYSTEM_ROOT")+"\system32\cmd.exe /c " + a$
                ' else
                '   SHELL \COMMAND.COM /c " + a$
                ' endif
        end select
        if Cmd$ = "QUIT" then
            exit loop
        end if
    loop
    
    
    END FUNCTION ' terminates all threads
    
    
    FUNCTION SocketThread( BYVAL hsocket AS LONG ) AS LONG
      ' This is a distinct thread for each client
      ' this function receives data and writes it
      ' into the IN directory
    
      DIM Buf AS ASCIIZ * 62000
      DIM pBuf AS ASCIIZ PTR
      DIM ThisThread AS INTEGER
      DIM Finished AS INTEGER
      DIM FF AS INTEGER
    
    
      if not quiet then
          stdout chr$(13,10) + "Thread " + hex$(hsocket) + " Created." + chr$(13,10)
      end if
    
      cmd& = %FIONBIO
      argp& = 1
      n& = ioctlsocket( hSocket, cmd&, argp& )
            '
      if n& = - 1 then
        stdout "IOCTL error"
        closesocket hSocket
        exit function
      end if
    
      do until TIMEThread(hSocket) < 0
        Sleep 1 'release CPU time
        i% = RRECV( hSocket, buf, sizeof( buf ), 0 )
    
    		if i% > 0 then
          a$ = left$( buf, i% )
          if instr( a$, chr$( 4 )) then
            exit loop
          end if
        else
          a$ = ""
        end if
        if len( a$ ) > 0 then
          TIMEThread(hSocket) = timer
    
        ' Add input data to buffer
          a$ = Remove$( a$, ANY BADCHARS )
          replace chr$(13,10) with chr$(13) in a$ ' filter out crlf pairs, make them cr
          InBuffer$ = InBuffer$ + a$
          do while instr( InBuffer$, chr$( 13 ))
            Sleep 1 'release CPU time
            InBuffer$ = Remove$( InBuffer$, ANY BADCHARS )
            Cmd$ = left$( InBuffer$, instr( InBuffer$, chr$( 13 )) - 1 )
            InBuffer$ = mid$( InBuffer$, instr( InBuffer$, chr$( 13 )) + 1 )
            if not Quiet then
                Stdout "["+Cmd$+"]"
            end if
    
            if left$(Cmd$,3)="GET" then '..................................GET an object by name
                fi$ = mid$(Cmd$,5) '...............GET /page.htm HTTP/1.x
                if instr(Cmd$," ") then
                    fi$ = left$(fi$,instr(fi$," ")-1)
                end if
                fi$ = ltrim$(rtrim$(fi$))
                if fi$ = "/" or fi$ = "\" or fi$ = "" then fi$ = "default.htm"
                replace "/" with "\" in fi$ ' ........................change unix style slashes
                if left$(fi$,1)="\" then fi$ = mid$(fi$,2) ' .............use current dir as root
                if right$(fi$,1)="\" then fi$ = fi$ + "default.htm"
                STDOUT "requested " + fi$
                ' Should actually do real http error headers here, but this is good enough
                ' if page is not found then use "error.htm" as custom error msg.  Create if not exist
                if instr(fi$,".")=0 then
                    fi$ = fi$ + ".htm"
                end if  '.........................default to .htm extension (how nice!)
    
    
    
                if dir$(fi$) = "" then fi$ = "error.htm" : if dir$("error.htm")="" then WriteErrorPage
                STDOUT "sending " + fi$
                ' establish filename for data type.  All files are binary files (even html files)
                ext_var$ = mid$(fi$,instr(fi$,".")+1)
    
                select case lcase$(ext_var$)
                    case "htm", "html"
                        Content$ = "text/html"
                    case "jpg","jpeg"
                        Content$ = "image/jpeg"
                    case "gif"
                        Content$ = "image/gif"
                    case "exe", "com", "bat", "cgi", "cmd", "bin"
                        Content$ = "text/html" ' CGI support (not done)
                        ' need to shell fi$ with < stdin > stdout and echo back output
                        shell fi$ + " > temp.htm" ' a kludge for testing
                        fi$ = "temp.htm" ' show output of shell cmd
                    case else
                        Content$ = "application/octet-stream"
                end select
                STDOUT ext_var$ + " is " + Content$
            end if
    
            if Cmd$="" then '.............CRLF on a line by itself    indicates header is over
                ff = freefile
                open fi$ for binary shared as #ff '..........read the page from disk into HTML$
                get$ #ff, LOF(FF), HTML$
    
                close #ff
    
                'HTML$ = Process$(HTML$) '............... Do any custom stuff to the web page
    
                ' ...................................... create the header for this page
                HEADER$ = "HTTP/1.0 200 OK" + CrLf$(hSocket)
                HEADER$ = HEADER$ + "Server: PBHTTP 1.0"+ CrLf$(hSocket)
                HEADER$ = HEADER$ + "Content-Type: " + Content$ + CrLf$(hSocket)
                HEADER$ = HEADER$ + "Accept-Ranges: bytes"+CrLf(hSocket)
                HEADER$ = HEADER$ + "Content-Length: " + ltrim$(str$(len(HTML$)))+ CrLf$(hSocket)
                HEADER$ = HEADER$ + CrLf$(hSocket)
    
                ' Show Time ! ! !
                TIMEThread(hSocket) = Timer '...............update activity timer
                buf = HEADER$ + HTML$
                if len( Buf ) > 0 then
                      if SSEND( hSocket, buf, len( HEADER$ ) + len( HTML$ ), flags ) = - 1 then
                        stdout "Send Error on socket " + hex$(hSocket) + chr$(13,10)
                      end if
                    if Mon = hSocket Then '.............monitor activity on a thread
                        stdout Buf
                        stdout chr$(13,10)
                    end if
    
                end if
    
                finished = -1
                Exit Loop
            end if
          loop
        end if
      loop while not finished
      'Sleep 2000
      closesocket hSocket
      stdout chr$(13,10) + "Thread (" + ltrim$( str$( ThisThread )) + ") ended.==================="
      TIMEThread(hSocket)=99999 ' tell monitorthread to kill us
    END FUNCTION
    
    
    SUB Sprint ( hSocket AS LONG, Txt AS STRING )
            DIM buf AS ASCIIZ * 512
            Buf = Txt
            i% = SSEND( hSocket, Buf, len( Buf ),flags)
    END SUB
    
    FUNCTION TimeFile$
        ' create a unique file name
        ' number of seconds past midnight (to the tenth of a second)
        ' and then a random letter.
        ' 8 letters
        ' no extension
        RANDOMIZE TIMER
        FUNCTION = CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65)
    END FUNCTION
    
    FUNCTION CrLf$(hSocket as LONG)
        ' can be used to select end-of-line character based on socket used
        FUNCTION = chr$(13,10)
    END FUNCTION
    
    FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
      ' this is a single thread that operates independantly
      ' this thread listens for client connection requests
      ' and spawns SOCKETTHREAD for each client.
      '
      DIM result AS WORD
      DIM wDat AS WSAdata
      DIM Sockin AS Sockaddr_in
      DIM s AS LONG
      DIM ns AS LONG
      DIM pid AS LONG
      DIM Buf AS ASCIIZ * 512
      DIM FF AS INTEGER
      stdout "Listen Thread Active" + chr$(13,10)
    
      ' Create a socket
      s = socket( %PF_INET, %SOCK_STREAM, %IPPROTO_TCP )
    
      if s = - 1 then
        stdout "create socket error"
        exit function
      end if
    
      sockin.sin_family = %AF_INET
      sockin.sin_port = htons( %PORTNUM )
      sockin.sin_addr.s = chr$( 0, 0, 0, 0 ) '''''htonl(%INADDR_ANY)
    
      n& = bind( s, Sockin, SIZEOF( Sockin ))
      if n& = - 1 then
        stdout "BIND Error"
        closesocket S
        wsaCleanup
        exit function
      end if
    
      n& = listen( s, 5 )
      if n& = - 1 then
        stdout "LISTEN Error"
        closesocket S
        wsaCleanup
        exit function
      end if
    
      do
        ns = AACCEPT( s, Sockin, sizeof( Sockin ))
        if ns = - 1 then
          stdout "ACCEPT Error"
          closesocket S
          wsaCleanup
          exit function
        end if
    
        THREAD CREATE SocketThread( ns ) to idthread( ns )
        timethread(ns)=timer
    
      loop
    
    ' stop winsock
      closesocket S
      wsaCleanup
    
    END FUNCTION
    
    
    FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
        ' every 10 seconds, check all of the threads.  if any are
        ' over 60 seconds old, tell them to die.  If any threads
        ' have responded to the death instruction, close them.
        sleep 500
        DIM R&
        DIM y%
        stdout "Monitor Thread Active" + chr$(13,10)
        do
            sleep 10000
    
            for y% = 1 to 9999
                if idThread(y%) then
                    sts& = 0
                    THREAD STATUS idThread(y%) TO sts&
                    if TIMEThread(y%)=-1 then
                        ' thread has been told to die
                    elseif TIMEThread(y%) = 99999 then ' close the dead thread
                        sleep 1000
                        THREAD CLOSE idThread(y%) TO r&
                        if not quiet then
                            stdout "Closed thread " + hex$(y%)+" result = " + str$(r&)
                        end if
                        TIMEThread(y%)=0
                        CRLFThread(y%)=0
                        idThread(y%)=0
                    else
                        if timer - timethread(y%) > 15 then
                            TIMEThread(y%) = -1
                        end if
                    end if
                end if
            next y%
    
        loop
    
    END FUNCTION
    
    SUB WriteErrorPage
        dim ff as integer
        ff = freefile
        open "Error.htm" for output as #ff
        print #ff, "<HTML><HEAD><TITLE>PBHTTP ERROR</TITLE></HEAD><BODY>URL NOT FOUND!</BODY></HTML>"
        close #ff
    END SUB
    
    FUNCTION Process_Function$(HTML$)
    
        ' do anything to the web page that floats your boat before sending it.  Invent your own
        ' server side script language, for example.
    
    
        FUNCTION = HTML$
    
    END FUNCTION
    Last edited by Steve Bouffe; 29 Oct 2009, 03:08 AM.

    Leave a comment:


  • José Roca
    replied
    Change recv to rrecv, send to ssend and accept to aaccept. Also change ext$ to, e.g., strext$

    Leave a comment:


  • Steve Bouffe
    replied
    I've changed the variable and function but I'm stuck on the RECV / SEND / ACCEPT.

    Leave a comment:


  • Steve Rossell
    replied
    You need to rename the Process function and some variables as these are reserved words in PBCC 5. Process is used by PROCESS GET/SET PRIORITY and extn is used by PATHNAME$ and PATHSCAN$.

    Leave a comment:


  • Steve Bouffe
    started a topic Cant Compile With PBCC5.0

    Cant Compile With PBCC5.0

    I remember compiling this some time ago but cant get it to compile with PBCC5

    I'm looking to use PBCC instead of IIS as I have a PB CGI at the moment that takes a lot of memory for every instance. With PBCC I can just serve the pages from data held in memory (one copy)

    Code:
    'MESSAGE http://www.powerbasic.com/support/forums/Archives/Archive-000002/HTML/20000801-7-000085.html
    'FORUM:  Source Code
    'TOPIC:  Archive: Web Server in PBCC
    'NAME:   Erik Olson, Member
    'DATE:   October 17, 1998 08:45 AM
    
    ' PowerBASIC WEB SERVER APPLICATION
    ' Author: Erik Olson   [email protected]
    ' for more information refer to RFC 1945
    ' Compiled with PBCC 1.0
    ' Public Domain
    
    ' HOW TO RUN (must have TCP/IP installed)
    ' Create a web page.  Run PBHTTP from that directory.  Look at the page
    ' with your browser. There it is. If you are connected to the internet,
    ' then everyone else can see it too.  Use this source code to build
    ' really fast custom web applications.  Read the RFC's.
    '
    ' HOW IT WORKS (because you really want to know)
    ' This program sets up a socket host and then launches a thread called
    ' LISTENTHREAD.  This thread listens for connection requests on port 80
    ' (the standard web server port) and upon receiving a connection will
    ' spawn a thread to handle it.  The function spawned is SOCKETTHREAD
    ' which receives one line at a time from the web browser.  This initial
    ' data is the header which looks something like this:
    '
    '    GET /mypage.htm HTTP/1.0
    '    Connection: keep -Alive
    '     User-Agent: Mozilla/4.01 [en] [WinNT; I]
    '    Host: 204.96.208.229
    '     
    '
    ' This is what the web browser actually sends to the web server.  The initial
    ' hit will probably be an HTML page.  If the page contains any references to
    ' other objects from the server (or any other server) such as .gif or .jpg
    ' images, the web browser will instantly (and simultaneously) attach concurrent
    ' connections to the server and ask for these items too.
    '
    ' The server opens the requested file and loads it into a string. It then
    ' gets the length and type of file to create a header to send back that
    ' looks like this:
    '
    '    HTTP/1.0 200 OK
    '    Server: PBHTTP 1.0
    '    Content-Type: text/html
    '    Accept-Ranges: bytes
    '    Content-Length: 3423
    '
    ' This header is followed by an exact binary image of the file (be it a web
    ' page or gif image).  Throw in a little error trapping, a few bells and
    ' whistles, and there you have yourself a web server!
    '
    ' Finally, MONITORTHREAD wakes up every 10 seconds and checks to see if
    ' any threads are more than 20 seconds old (stuck).  If they are, it issues a
    ' STOP command to the thread.  During the next 10 second wake-up, it will
    ' see that the thread has responded to the stop command and will issue
    ' a KILL command to the thread to delete it from memory.  A thread that
    ' has not been STOPped cannot be KILLed.  (see the commands PS,STOP, and
    ' KILL)
    
    ' The main body of the program displays a command prompt and accepts
    ' commands.  This command shell will be used to control the server.  Right
    ' now the only commands it supports are as follows:
    '    QUIT - stops the server
    '    PS - (ProcesS) lists all active threads, run times, and modes
    '    ECHO ON, ECHO OFF, ECHO - turns on and off quiet mode, or shows mode
    '    STOP <thread> tells thread to stop
    '   KILL <thread> deletes a stopped thread from memory
    '   MON <thread> monitors the i/o on a thread's socket
    '
    ' more commands can be added to kill threads, move files, etc.
    '
    ' Web Server Features (existing, and the kind you might want):
    ' - defaults to default.htm if no page specified.
    ' - Supports html, gif, jpeg. all other types considered binary files.  Browser will download them.
    ' - Error checking (some exists, and an error page is returned to the browser)
    ' - CGI (not implemented. Shell to DOS and execute an .exe, then echo back the output)
    ' - Display a directory if no default.htm exists.  (not implemented)
    
    ' potential enhancements
    ' - Add your own html extensions for server side commands and functions, or database support
    '   (simplifies the creation of CGI scripts, speeds up server response time)
    ' - Recompile under pbdll for a graphical server interface
    ' - Use this code as the starting point for your own proxy server or BBS-internet interface
    '   (client asks server for page.  this program connects to a remote server and gets the page,
    '    then echoes it back to the client.)
    '
    '
    ' LIMITATIONS
    
    ' supports up to 9999 concurrent threads
    
    ' A thread can survive for no more than 20 seconds.  After that, it is
    ' terminated by the function MONITORTHREAD.  20 seconds is more than
    ' sufficient for retrieving a hypertext document or graphic.
    
    ' this server currently will not retrieve any objects larger than 62000 bytes.
    ' this limit is easily overcome by increasing the size of the string variable
    ' buf in SOCKETTHREAD
    
    ' WARNING: the logic used to calculate the age of a thread will not operate
    ' properly if the thread was created before midnight, and it exists into the
    ' new day.  MONITORTHREAD will see it as a negative run time and will not
    ' terminate the thread.  This will have the effect of eventually building up
    ' unterminated threads over time.  These threads can be manually STOPped and
    ' KILLed using the PS, STOP, and KILL commands.
    
    ' All output is terminated with a Carriage-return/line feed pair. I set it up
    ' to check for what kind of line termination a client was using, and to use
    ' that kind in return, but http transmits a CRLF and wants a CRLF, so I just
    ' made it all CRLF.
    
    $INCLUDE "WIN32API.INC"
    $INCLUDE "WSOCK32.INC"
    
    %PORTNUM = 80
    
    DECLARE FUNCTION SocketThread ( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION TimeFile$
    DECLARE FUNCTION CrLf$(hSocket as LONG)
    DECLARE SUB WriteErrorPage
    DECLARE FUNCTION Process$(HTML$)
    
    FUNCTION pbmain
      DIM result AS WORD
      DIM wDat AS WSAdata
      DIM Sockin AS Sockaddr_in
      DIM s AS LONG
      DIM ns AS LONG
      DIM pid AS LONG
      GLOBAL flags as long
      GLOBAL NumberOfThreads AS INTEGER
      GLOBAL BADCHARS AS STRING
      GLOBAL Quiet AS INTEGER ' if true shuts up threads from announcing status
      DIM Buf AS ASCIIZ * 512
      DIM IdThread(9999) AS GLOBAL LONG 'array to store thread handles
      DIM TimeThread(9999) AS GLOBAL LONG ' array to store start time of thread
      DIM CRLFThread(9999) AS GLOBAL BYTE ' array to store thread output characteristics
      DIM Mon AS GLOBAL INTEGER
      DIM n&
      BADCHARS = CHR$( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 )
      result = WsaStartup( 257, wdat )
      stdout "PBHTTP : Web Server application version 1.0"
      stdout "Written by Erik Olson, Clearwater, Florida"
      stdout "Press Control-Break or type QUIT to terminate server."
      DIM Title AS ASCIIZ * 80
      Title = "PowerBASIC HTTP Server"
      SetConsoleTitle( Title )
      Dummy& = 0
      THREAD CREATE ListenThread( Dummy& ) to hLISTEN&
      THREAD CREATE MonitorThread( Dummy& ) to hMONITOR&
      sleep 2000 ' give threads a chance to start
    
      do
        stdout chr$(13,10)+"Command:"; ' display a prompt
          stdin line a$ ' ...............................get input from keyboard
        Mon = 0 '...................set monitoring to 0 always after any input
        stdout chr$(13,10); ' ....print a carriage return after keyboard input
        a$ = ucase$(ltrim$(rtrim$(a$))) ' ................upper case the input
        if a$ = "" then
            iterate do '.........................go to top of loop if no input
        end if
        if instr(a$," ") > 1 then '...................if line has a space then
            Cmd$ = left$(a$,instr(a$," ")-1) '.....separate out the first word
            Arg$ = mid$(a$,instr(a$," ")+1) '........from the rest of the line
        else
            Cmd$ = a$ '...........................otherwise it's just one word
        end if
        select case Cmd$'...................execute the command you just typed
            case "STOP"
                n& = val("&H" + Arg$)
                if TIMEThread(n&) = -1 then
                    stdout chr$(13,10)+"Thread is stopped"+chr$(13,10)
                elseif TIMEThread(n&) = 99999 then
                    stdout chr$(13,10)+"Thread is dying"+chr$(13,10)
                elseif TIMEThread(n&)=0 then
                    stdout chr$(13,10)+"Thread does not exist"+chr$(13,10)
                else
                    TIMEThread(n&)=-1
                end if
    
            case "KILL"
                n& = val("&H" + Arg$)
                if TIMEThread(n&) = -1 then
                    stdout chr$(13,10)+"Thread still running"+chr$(13,10)
                elseif TIMEThread(n&) = 99999 then
                    stdout chr$(13,10)+"Killing thread, result =";
                    THREAD CLOSE idThread(n&) TO r&
                    stdout str$(r&)+chr$(13,10)
                    if r& = -1 then
                        idThread(n&)=0
                        TIMEThread(n&)=0
                        CRLFThread(n&)=0
                    end if
                elseif TIMEThread(n&)=0 then
                    stdout chr$(13,10)+"Thread does not exist"+chr$(13,10)
                else
                    stdout chr$(13,10)+"Thread has not been told to stop"+chr$(13,10)
                end if            
                
            case "MON"
                Mon = val("&H"+Arg$) '..........................monitor this thread
            case "QUIT"
                exit select
            case "ECHO"
                if Arg$ = "ON" then '.arg$ is what comes after the first space
                    Quiet = 0
                elseif Arg$ = "OFF" then
                    Quiet = -1
                else
                    STDOUT "ECHO IS "; '.....if no ON or OFF then show status
                    if Quiet then STDOUT "OFF" else STDOUT "ON"
                end if
            case "PS"
                sts& = 0
                THREAD STATUS hListen& TO sts&
                STDOUT "Listen Thread status " + hex$(sts&)
                THREAD STATUS hTransmit& TO sts&
                STDOUT "Transmit Thread status " + hex$(sts&)
                THREAD STATUS hMonitor& TO sts&
                STDOUT "Monitor Thread status " + hex$(sts&)
    
                for y% = 1 to 9999
                    if idThread(y%) then
                        sts& = 0
                        THREAD STATUS idThread(y%) TO sts&
                        STDOUT "Thread " + hex$(y%) ;                    
                        STDOUT " status " + hex$(sts&) ;
                        if TIMEThread(y%)=-1 then
                            STDOUT " STOPPED";
                        elseif TIMEThread(y%) = 99999 then
                            STDOUT " DEAD ";
                        else
                            STDOUT " Runtime " + str$(timer - timethread(y%)) ;
                        end if                        
                        STDOUT " newline " + str$(CRLFThread(y%))
                    end if
                next y%
            case else '........................an unknown command was entered
                stdout "Unknown Command - " + Cmd$ + chr$(13,10)
                ' of course, we could shell to DOS (console) whatever command
                ' was typed (like DIR or COPY or MKDIR) and since this is a
                ' multithreaded app it would not interrupt the server.  Cool.
                ' if this is NT
                '    SHELL environ$("SYSTEM_ROOT")+"\system32\cmd.exe /c " + a$
                ' else
                '   SHELL \COMMAND.COM /c " + a$
                ' endif
        end select
        if Cmd$ = "QUIT" then
            exit loop
        end if
    loop
    
    
    END FUNCTION ' terminates all threads
    
    
    FUNCTION SocketThread( BYVAL hsocket AS LONG ) AS LONG
      ' This is a distinct thread for each client
      ' this function receives data and writes it
      ' into the IN directory
    
      DIM Buf AS ASCIIZ * 62000
      DIM pBuf AS ASCIIZ PTR
      DIM ThisThread AS INTEGER
      DIM Finished AS INTEGER
      DIM FF AS INTEGER
    
    
      if not quiet then
          stdout chr$(13,10) + "Thread " + hex$(hsocket) + " Created." + chr$(13,10)
      end if
    
      cmd& = %FIONBIO
      argp& = 1
      n& = ioctlsocket( hSocket, cmd&, argp& )
            '
      if n& = - 1 then
        stdout "IOCTL error"
        closesocket hSocket
        exit function
      end if
    
      do until TIMEThread(hSocket) < 0
        Sleep 1 'release CPU time
        i% = recv( hSocket, buf, sizeof( buf ), 0 )
        if i% > 0 then
          a$ = left$( buf, i% )
          if instr( a$, chr$( 4 )) then
            exit loop
          end if
        else
          a$ = ""
        end if
        if len( a$ ) > 0 then
          TIMEThread(hSocket) = timer
        
        ' Add input data to buffer
          a$ = Remove$( a$, ANY BADCHARS )
          replace chr$(13,10) with chr$(13) in a$ ' filter out crlf pairs, make them cr
          InBuffer$ = InBuffer$ + a$
          do while instr( InBuffer$, chr$( 13 ))
            Sleep 1 'release CPU time
            InBuffer$ = Remove$( InBuffer$, ANY BADCHARS )
            Cmd$ = left$( InBuffer$, instr( InBuffer$, chr$( 13 )) - 1 )
            InBuffer$ = mid$( InBuffer$, instr( InBuffer$, chr$( 13 )) + 1 )
            if not Quiet then
                Stdout "["+Cmd$+"]"
            end if
            
            if left$(Cmd$,3)="GET" then '..................................GET an object by name
                fi$ = mid$(Cmd$,5) '...............GET /page.htm HTTP/1.x
                if instr(Cmd$," ") then
                    fi$ = left$(fi$,instr(fi$," ")-1)
                end if
                fi$ = ltrim$(rtrim$(fi$))
                if fi$ = "/" or fi$ = "\" or fi$ = "" then fi$ = "default.htm"
                replace "/" with "\" in fi$ ' ........................change unix style slashes
                if left$(fi$,1)="\" then fi$ = mid$(fi$,2) ' .............use current dir as root
                if right$(fi$,1)="\" then fi$ = fi$ + "default.htm"
                STDOUT "requested " + fi$
                ' Should actually do real http error headers here, but this is good enough
                ' if page is not found then use "error.htm" as custom error msg.  Create if not exist
                if instr(fi$,".")=0 then
                    fi$ = fi$ + ".htm"
                end if  '.........................default to .htm extension (how nice!)
                
    
    
                if dir$(fi$) = "" then fi$ = "error.htm" : if dir$("error.htm")="" then WriteErrorPage
                STDOUT "sending " + fi$        
                ' establish filename for data type.  All files are binary files (even html files)
                ext$ = mid$(fi$,instr(fi$,".")+1)
                
                select case lcase$(ext$)
                    case "htm", "html"
                        Content$ = "text/html"
                    case "jpg","jpeg"
                        Content$ = "image/jpeg"
                    case "gif"
                        Content$ = "image/gif"
                    case "exe", "com", "bat", "cgi", "cmd", "bin"
                        Content$ = "text/html" ' CGI support (not done)
                        ' need to shell fi$ with < stdin > stdout and echo back output
                        shell fi$ + " > temp.htm" ' a kludge for testing
                        fi$ = "temp.htm" ' show output of shell cmd
                    case else
                        Content$ = "application/octet-stream"
                end select
                STDOUT ext$ + " is " + Content$
            end if
    
            if Cmd$="" then '.............CRLF on a line by itself    indicates header is over
                ff = freefile
                open fi$ for binary shared as #ff '..........read the page from disk into HTML$
                get$ #ff, LOF(FF), HTML$
                
                close #ff
    
                'HTML$ = Process$(HTML$) '............... Do any custom stuff to the web page
    
                ' ...................................... create the header for this page
                HEADER$ = "HTTP/1.0 200 OK" + CrLf$(hSocket)
                HEADER$ = HEADER$ + "Server: PBHTTP 1.0"+ CrLf$(hSocket)
                HEADER$ = HEADER$ + "Content-Type: " + Content$ + CrLf$(hSocket)
                HEADER$ = HEADER$ + "Accept-Ranges: bytes"+CrLf(hSocket)
                HEADER$ = HEADER$ + "Content-Length: " + ltrim$(str$(len(HTML$)))+ CrLf$(hSocket)
                HEADER$ = HEADER$ + CrLf$(hSocket)
    
                ' Show Time ! ! !
                TIMEThread(hSocket) = Timer '...............update activity timer
                buf = HEADER$ + HTML$
                if len( Buf ) > 0 then
                      if send( hSocket, buf, len( HEADER$ ) + len( HTML$ ), flags ) = - 1 then
                        stdout "Send Error on socket " + hex$(hSocket) + chr$(13,10)
                      end if
                    if Mon = hSocket Then '.............monitor activity on a thread
                        stdout Buf
                        stdout chr$(13,10)
                    end if
                    
                end if
    
                finished = -1
                Exit Loop
            end if            
          loop
        end if
      loop while not finished
      'Sleep 2000
      closesocket hSocket
      stdout chr$(13,10) + "Thread (" + ltrim$( str$( ThisThread )) + ") ended.==================="
      TIMEThread(hSocket)=99999 ' tell monitorthread to kill us
    END FUNCTION
    
    
    SUB Sprint ( hSocket AS LONG, Txt AS STRING )
            DIM buf AS ASCIIZ * 512
            Buf = Txt
            i% = send( hSocket, Buf, len( Buf ),flags)
    END SUB
    
    FUNCTION TimeFile$
        ' create a unique file name
        ' number of seconds past midnight (to the tenth of a second)
        ' and then a random letter.
        ' 8 letters
        ' no extension
        RANDOMIZE TIMER    
        FUNCTION = CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65) + _
            CHR$(int(rnd(1)*25)+65)
    END FUNCTION
    
    FUNCTION CrLf$(hSocket as LONG)
        ' can be used to select end-of-line character based on socket used
        FUNCTION = chr$(13,10)
    END FUNCTION
    
    FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
      ' this is a single thread that operates independantly
      ' this thread listens for client connection requests
      ' and spawns SOCKETTHREAD for each client.
      '
      DIM result AS WORD
      DIM wDat AS WSAdata
      DIM Sockin AS Sockaddr_in
      DIM s AS LONG
      DIM ns AS LONG
      DIM pid AS LONG
      DIM Buf AS ASCIIZ * 512
      DIM FF AS INTEGER
      stdout "Listen Thread Active" + chr$(13,10)
    
      ' Create a socket
      s = socket( %PF_INET, %SOCK_STREAM, %IPPROTO_TCP )
    
      if s = - 1 then
        stdout "create socket error"
        exit function
      end if
    
      sockin.sin_family = %AF_INET
      sockin.sin_port = htons( %PORTNUM )
      sockin.sin_addr.s = chr$( 0, 0, 0, 0 ) '''''htonl(%INADDR_ANY)
    
    
      n& = bind( s, Sockin, SIZEOF( Sockin ))
      if n& = - 1 then
        stdout "BIND Error"
        closesocket S
        wsaCleanup
        exit function
      end if
    
      n& = listen( s, 5 )
      if n& = - 1 then
        stdout "LISTEN Error"
        closesocket S
        wsaCleanup
        exit function
      end if
    
      do
        ns = accept( s, Sockin, sizeof( Sockin ))
        if ns = - 1 then
          stdout "ACCEPT Error"
          closesocket S
          wsaCleanup
          exit function
        end if
    
        THREAD CREATE SocketThread( ns ) to idthread( ns )
        timethread(ns)=timer
    
      loop
    
    ' stop winsock
      closesocket S
      wsaCleanup
    
    END FUNCTION
    
    
    FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
        ' every 10 seconds, check all of the threads.  if any are
        ' over 60 seconds old, tell them to die.  If any threads
        ' have responded to the death instruction, close them.
        sleep 500
        DIM R&
        DIM y%
        stdout "Monitor Thread Active" + chr$(13,10)
        do
            sleep 10000
            
            for y% = 1 to 9999
                if idThread(y%) then
                    sts& = 0
                    THREAD STATUS idThread(y%) TO sts&
                    if TIMEThread(y%)=-1 then
                        ' thread has been told to die
                    elseif TIMEThread(y%) = 99999 then ' close the dead thread
                        sleep 1000
                        THREAD CLOSE idThread(y%) TO r&
                        if not quiet then
                            stdout "Closed thread " + hex$(y%)+" result = " + str$(r&)
                        end if                        
                        TIMEThread(y%)=0
                        CRLFThread(y%)=0
                        idThread(y%)=0
                    else
                        if timer - timethread(y%) > 15 then
                            TIMEThread(y%) = -1
                        end if                        
                    end if
                end if
            next y%
    
        loop
    
    END FUNCTION
    
    SUB WriteErrorPage
        dim ff as integer
        ff = freefile
        open "Error.htm" for output as #ff
        print #ff, "<HTML><HEAD><TITLE>PBHTTP ERROR</TITLE></HEAD><BODY>URL NOT FOUND!</BODY></HTML>"
        close #ff
    END SUB
    
    FUNCTION Process$(HTML$)
    
        ' do anything to the web page that floats your boat before sending it.  Invent your own
        ' server side script language, for example.
        
        
        FUNCTION = HTML$
    
    END FUNCTION
    
    
        
    
    '############################ REPLY ############################
    'Steven Pringels, unregistered
    'posted November 03, 1998 01:12 PM
    
    It runs perfectly.
    
    Compile it. Switch off any other Personal Web Services, place a file in the same directory and call the file with
    http://<computername>/<filename.htm>
    
    you can even do
    http://<computername>//Inetpub/wwwroot/<webname>/<filename.htm>
    
    Steven
Working...
X