home *** CD-ROM | disk | FTP | other *** search
/ IT.SOFT 22 / ITSOFTCD_22.iso / pc / shareware22 / file3 / VQSERVER.ZIP / cgi / post / post.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-30  |  3.2 KB  |  150 lines
  1. program post;
  2. {
  3. post version 1.06.
  4. post is a demonstration CGI script supplied with vqServer.
  5. post is written in Borland Pascal version 7.
  6. post runs on MS-DOS systems only.
  7. post and vqServer are copyright vqSoft and Steve Shering 1997-98.
  8. }
  9. uses
  10.   dos;
  11.  
  12. const
  13.   endfield='=';
  14.   enddata='&';
  15.  
  16. var
  17.   tnf:integer;
  18.   tfield:array[1..10]of string;
  19.   tdata:array[1..10]of string;
  20.  
  21.   chrsread:integer;
  22.   datalength:integer;
  23.  
  24.   i:integer;
  25.  
  26.   year,month,day,dow,hour,min,sec,sec100:word;
  27.  
  28.  
  29. function strof(tnum:longint):string;
  30. var
  31.   tstr:string;
  32. begin
  33.   str(tnum,tstr);
  34.   strof:=tstr;
  35. end;
  36.  
  37. function numof(tstr:string):integer;
  38. var
  39.   tnum:integer;
  40.   errcode:integer;
  41. begin
  42.   val(tstr,tnum,errcode);
  43.   numof:=tnum;
  44. end;
  45.  
  46. function readchar:char;
  47. var
  48.   tchar:char;
  49. begin
  50.   if chrsread<=datalength then
  51.     begin
  52.       read(tchar);
  53.       chrsread:=chrsread+1;
  54.     end
  55.   else
  56.     tchar:=chr(0);
  57.   readchar:=tchar;
  58. end;
  59.  
  60. function readword(endchar:char):string;
  61. var
  62.   done:boolean;
  63.   tword:string;
  64.   i1:char;
  65. begin
  66.   done:=false;
  67.   tword:='';
  68.   while (not done) do
  69.     begin
  70.       i1:=readchar;
  71.       if i1='%' then
  72.         tword:=tword+chr(numof('$'+readchar+readchar))
  73.       else if i1='+' then
  74.         tword:=tword+' '
  75.       else if (i1=endchar) or (i1=chr(0)) then
  76.         done:=true
  77.       else
  78.         tword:=tword+i1;
  79.     end;
  80.   readword:=tword;
  81. end;
  82.  
  83. procedure readpair(tpair:integer);
  84. begin
  85.   tfield[tpair]:=readword(endfield);
  86.   tdata[tpair]:=readword(enddata);
  87. end;
  88.  
  89. procedure readdata;
  90. var
  91.   datalengthstring:string;
  92. begin
  93.   datalengthstring:=getenv('CONTENT_LENGTH');
  94.   datalength:=numof(datalengthstring);
  95.   chrsread:=0;
  96.   tnf:=0;
  97.   while chrsread<=datalength do
  98.     begin
  99.       tnf:=tnf+1;
  100.       readpair(tnf);
  101.     end;
  102. end;
  103.  
  104. begin
  105.  
  106. writeln('Content-Type: text/html');
  107. writeln;
  108. writeln('<html>');
  109. writeln('<head>');
  110. writeln('<title>Demo CGI script (POST method)<TITLE>');
  111. writeln('</head>');
  112. writeln('<body bgcolor=#add8af>');
  113. writeln('<table border=0 cellspacing=0 cellpadding=2 cols=3 width=100%>');
  114. writeln('<tr>');
  115. writeln('<td valign=top>');
  116. writeln('<center>');
  117. writeln('<H1 ALIGN=CENTER>Demo CGI script (POST method)</H1>');
  118. writeln('</center>');
  119. writeln('<P><HR></P>');
  120.  
  121.  
  122. writeln('<P>This is some of the information your browser sent.</p>');
  123. writeln('<LI>','Your name: ',getenv('REMOTE_HOST'),'</LI>');
  124. writeln('<LI>','Your IP address: ',getenv('REMOTE_ADDR'),'</LI>');
  125. writeln('<LI>','Bytes of data: ',getenv('CONTENT_LENGTH'),'</LI>');
  126.  
  127. readdata;
  128.  
  129. writeln('<P>The following information was received by the server.</P>');
  130. i:=1;
  131. while i<=tnf do
  132.   begin
  133.     writeln('<LI>',tfield[i],': ',tdata[i],'</LI>');
  134.     i:=i+1;
  135.   end;
  136.  
  137. writeln('<P><hr></P>');
  138. writeln('<P>This page was generated by <i>post.exe</i> version 1.06.');
  139. writeln(' <i>post.exe</i> and <i>vq</i>Server are copyright © <i>vq</i>Soft and Steve Shering 1997-8.</p>');
  140. writeln('</td>');
  141. writeln('<td width=20></td>');
  142. writeln('<td valign=top width=150>');
  143. writeln('<A HREF=/index.html><IMG WIDTH=15 HEIGHT=15 BORDER=0 SRC=/vq/server/icons/utab.gif>Home page</A>');
  144. writeln('</td>');
  145. writeln('</tr>');
  146. writeln('</table>');
  147. writeln('</body>');
  148. writeln('</html>');
  149.  
  150. end.