Last year I made a very small web server with the help of Think Pascal. It was based on TCPExample code of Peter N Lewis from 1992. See the topic here:
https://68kmla.org/forums/index.php?/topic/21029-help-with-tcpexample-in-pascal/
At the end It got it running and it serves as a real web server. Web page is hard coded insight, but it works.
I'm not familiar with programming but try my best. One of my wishes is to improve it. So two questions:
- I now have a routine with a goto loop. So every time a web page is served the program loops to label 1. The program is also then unstoppable because it stays in this loop. I would love to have a better solution for that. Maybe someone has an idea what to do.
- I would really love to have it working as a real program. So an executable with a menu, an about, in file a start and stop, show log and quit the program. I have no idea how to do this in Think Pascal. I have been reading but didn't find a simple way of doing this. It has a relation with the Resource file, but I don't know what to do. Help in this is welkom. I'm even welcome if someone could offer me how to make a Hello World App with a menu!
Here is the program code:
program MacTjaapHTTPD10;
{ 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.7';
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 = '<html><body><h1>This is the welcome page of a MacTjaapHTTPD server for Macintosh. Version 0.7</h1><br>';
html2 = 'It is based on TCPExample from Peter N Lewis, copyright 1992<br><br>';
html3 = '<br><br>On this page is not much, but I will provide a link to the post in the 68kMLA forum:<br>';
html4 = '<a href=http://68kmla.org/forums/viewtopic.php?f=29&t=22235>click here</a>';
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
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.
httpd.p.txt
https://68kmla.org/forums/index.php?/topic/21029-help-with-tcpexample-in-pascal/
At the end It got it running and it serves as a real web server. Web page is hard coded insight, but it works.
I'm not familiar with programming but try my best. One of my wishes is to improve it. So two questions:
- I now have a routine with a goto loop. So every time a web page is served the program loops to label 1. The program is also then unstoppable because it stays in this loop. I would love to have a better solution for that. Maybe someone has an idea what to do.
- I would really love to have it working as a real program. So an executable with a menu, an about, in file a start and stop, show log and quit the program. I have no idea how to do this in Think Pascal. I have been reading but didn't find a simple way of doing this. It has a relation with the Resource file, but I don't know what to do. Help in this is welkom. I'm even welcome if someone could offer me how to make a Hello World App with a menu!
Here is the program code:
program MacTjaapHTTPD10;
{ 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.7';
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 = '<html><body><h1>This is the welcome page of a MacTjaapHTTPD server for Macintosh. Version 0.7</h1><br>';
html2 = 'It is based on TCPExample from Peter N Lewis, copyright 1992<br><br>';
html3 = '<br><br>On this page is not much, but I will provide a link to the post in the 68kMLA forum:<br>';
html4 = '<a href=http://68kmla.org/forums/viewtopic.php?f=29&t=22235>click here</a>';
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
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.
httpd.p.txt
