program MacTjaapHTTPD05;

{This is the code for a very simple test only web server. It can be build with Think Pascal and Peter's PNL Libraries and TCPExample}
{Version 0.5 is now capable of looping the opening of port 80, so you can have more then one request....that is nice for a web server }
{MacTjaapHTTPD runs on 6.0.5 and higher with MacTCP}

{ From Peter's PNL Libraries }
{ Copyright 1992 Peter N Lewis }
{ This source may be used for any non-commercial purposes as long as I get a mention }
{ in the About box and Docs of any derivative program.  It may not be used in any commercial }
{ application without my permission }


uses
 TCPTypes, TCPStuff, TCPConnections;




const
 header = 'HTTP/1.1 200 OK';
 headerserver = 'Server: MacTjaapHTTPD/0.5';
 headerdate = 'Date: Fri, 25 Oct 2013 23:54:00';
 headerconnection = 'Connection: close';
 headerlast = 'Last-Modified: Fri, 20 Apr 1962 01:30:00';
 headercontent = 'Content-Type: text/html';

 html = 'This is the welcome page of a MacTjaapHTTPD server for Macintosh.
';
 html2 = 'It is based on TCPExample from Peter N Lewis, copyright 1992

';
 html3 = '

On this page is not much, but I will provide a link to the post in the 68kMLA forum:
';
 html4 = 'click here';


 nul = chr(0);
 lf = chr(10);
 cr = chr(13);
 localport = 80;
 remotehost = 0;
 remoteport = 0;
 dataptr = 0;

label
 1;


var
 oe: OSErr;
 cp: connectionIndex;
 quitNow: boolean;
 cer: connectionEventRecord; { Event record for TCP events, simmilar to EventRecord }
 s: str255;
 t: str255;
 u: str255;
 v: str255;

 count: longInt;
 gotlinefeed: boolean;
 YN: Char;
 Name: string;



begin
ShowText;






1:
writeln('start listening on port 80');
quitNow := false;
oe := InitConnections; { Startup the TCP units }

if oe = noErr then begin
 count := 0;



 while not quitNow do begin

  oe := NewPassiveConnection(cp, Default_TCPBUFFERSIZE, localport, remotehost, remoteport, nil);
{    writeln(' hier ben je 1');    }
{while not Button do}
{;}

  if GetConnectionEvent(any_connection, cer) then begin


   case cer.event of
    C_Found:  begin
     writeln('hier ben je 2');






{---function NewPassiveConnection (var cp: connectionIndex; buffersize: longInt; localport: integer; remotehost: longInt; remoteport: integer; dataptr: univ ptr): OSErr;}

     oe := NewPassiveConnection(cp, Default_TCPBUFFERSIZE, localport, remotehost, remoteport, nil);




    end;

    C_Established:  begin { Happens once per succesful connection establishment }
     writeln('Connection Established');

     s := concat(header, cr, lf, headerserver, cr, lf, headerdate, cr, lf, headerlast, cr, lf, headercontent, cr, lf, cr, lf, html, cr, lf);
     t := concat(html2, cr, lf);
     u := concat(html3, cr, lf);
     v := concat(html4, cr, lf);

     oe := TCPSend(cer.tcpc, @s[1], length(s), true);
     oe := TCPSend(cer.tcpc, @t[1], length(t), true);
     oe := TCPSend(cer.tcpc, @u[1], length(u), true);
     oe := TCPSend(cer.tcpc, @v[1], length(v), true);

                           {to let the browser know that the page is sendI close the connection}
                           {function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;}
     CloseConnection(cer.connection); { Close our side of the connection }

{doet al wat----while not Button do}
{;}

     if oe <> noErr then
      CloseConnection(cp); { Better close the connection if we can't send anything to it! }
    end;
    C_FailedToOpen: 
     writeln('Ooops, connection failed to open... Error is ', cer.value, ' Timed out is ', cer.timedout);
{ Example, network unreachable etc.  Error code is in cer.value }
    C_Closing:  begin
     writeln('Connection closing');{ Gets called when the connection starts closing down}
     CloseConnection(cer.connection); { Close our side of the connection }
    end;
    C_Closed:  begin
     writeln('Connection closed, quit now');
     quitNow := true; { The connection is closed, quit the program }


{ gaat na klik weer door---while not Button do}
{;}
    end;
    C_CharsAvailable:  begin
{$PUSH}
{$R-}
     oe := TCPReceiveUpTo(cer.tcpc, 10, 60, @s[1], 255, count, gotlinefeed);
{ Recieve characters up to a line feed }
     if (count > 0) & (s[count] = lf) then { strip off linefeed }
      count := count - 1;
     if (count > 0) & (s[count] = cr) then { strip off cr }
      count := count - 1;
     s[0] := chr(count);
{$POP}
     if gotlinefeed then begin { if we got a linefeed, print the string, otherwise go round again and wait for more characters }
      writeln(s);
      count := 0;
     end;
    end;
   end;
  end;

 end;
 FinishEverything; { Close everything, clean up }
{ ALWAY CALL THIS, OR YOU WILL BE SORRY! }

 writeln('Click to quit');
 goto 1;
 while not Button do
  ;
end;
end.
end.