[fpc-pascal] CGI application

Wed May 19 21:54:35 CEST 2010

Thats me up & running now - thanks for your help guys, I'll certainly poke
around those CGI vars.

On 19 May 2010 14:19, Carsten Bager <carsten at beas.dk> wrote:

> > How do i get command line vars? i tried GetENV() but it didn't understand
> GetEnv() (which unit is
> > it in?)
>
>
> Here is a small cgi program. Comments are in Danish but I hope you can get
> the meaning.
> Carsten
>
>
> {Program version 1.00}
> program listdir2html;
> {LONGSTRINGS OFF}
>
> {$INFO +---------------------------------+}
> {$INFO | Statistik projekt til Oegendahl |}
> {$INFO +---------------------------------+}
>
> uses
>  dos,
>  classes,
>  uInit,
>  sysutils,    {System}
>  uSpStatus,
>  testbruger;
>
> var
>  QUERY_STRING:shortstring;
>
>
> Procedure PrintHeader(title:shortstring);
> Begin
>  Writeln('HTTP/1.0 200 OK');
>  Writeln('Server: Netscape-Communications/3.0');
>  Writeln('Content-type: text/html');
>  Writeln;
>  Writeln;
>  Writeln('<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01
> Transitional//EN">');
>  Writeln('<html>');
>  Writeln('  <head>');
>  Writeln('    <meta content="text/html;charset=windows-1252"
> http-equiv="Content-Type">');
>  Writeln('    <title>',title,'</title>');
>  Writeln('  </head>');
>  Writeln('  <body>');
>  Writeln('    <table style="background-color: rgb(153, 153, 153);
> text-align: center; width:
> 100%;" border="0" cellpadding="2" cellspacing="2">');
>  Writeln('      <tbody>');
>  Writeln('        <tr>');
>  Writeln('          <td style="font-size: 30px; font-weight: bold;">');
>  Writeln('            ',cFaellesOverskrift);
>  Writeln('          </td>');
>  Writeln('        </tr>');
>  Writeln('      </tbody>');
>  Writeln('    </table>');
>  Writeln('    <h2>');
>  Writeln('      ',title);
>  Writeln('    </h2>');
> End;
>
> Procedure PrintFooter;
> Begin
>  Writeln('    </p>');
>  Writeln('  </body>');
>  Writeln('</html>');
> End;
>
>
> Procedure FindOgListFiler(title,PartFileName:shortstring);
> var
>  Info:TSearchRec;
>  flist:tstringlist;
>  p:integer;
>  date,s:shortstring;
> Begin
>  flist:=tstringlist.create;
>  If FindFirst (PartFileName,faAnyFile,Info)=0 then       {Find f°rste fil}
>    begin
>      Repeat
>        flist.add(Info.Name);                   {Find de f°lgende filer}
>      Until FindNext(info)<>0;
>    end;
>    flist.sort;                                 {Soter filer}
>    p:=flist.count;
>    while p<>0 do                               {Print fil navn til HTML
> side}
>    begin
>      dec(p);
>      s:=flist.Strings[p];
>      date:=copy(s,succ(length(QUERY_STRING)),12);
>      date:=title+
>            copy(date,1,4)+
>            ' d. '+copy(date,7,2)+
>            '/'+copy(date,5,2)+
>            ' Kl. '+copy(date,9,2)+
>            ':'+copy(date,11,2);
>
>     // WriteLn('<a href="../log/',s,'">',date,'</a>');
>      WriteLn('<INPUT TYPE="BUTTON" VALUE="',date,'"
> ONCLICK="window.location.href=''http:','../log/',s,'''"><br>');
>      flist.delete(pred(flist.count));
>    end;
>  flist.free;
> End;
>
> begin
>  if not uSpStatus.InitShaerdMemory(InitShaerdMemoryStr,false) then
>  begin
>    PrintHeader('Beas login');
>    writeln ('Kan ikke initialisere shared memory<br>');
>    PrintFooter;
>    halt;
>  end;
>  if not ErBrugerOk then
>    halt(1);
>  QUERY_STRING:=getenv('QUERY_STRING');
>  if debug.Listdir2html then
>  begin
>    writeln(stderr);
>    writeln(stderr,'QUERY_STRING= ',QUERY_STRING);
>  end;
>  chdir('..');
>  if pos('Statistik',QUERY_STRING)<>0 then
>  begin
>    PrintHeader('Historiske statistik data fra blandeanlµg');
>    FindOgListFiler('Statistik fil fra ','./log/statistik*.html');
>    PrintFooter;
>  end;
>  if pos('Blandelog',QUERY_STRING)<>0 then
>  begin
>    PrintHeader('Historiske  log data fra blandeanlµg');
>    FindOgListFiler('Log fil fra ','./log/blandelog*.html');
>    PrintFooter;
>  end;
>  if pos('Program',QUERY_STRING)<>0 then
>  begin
>    PrintHeader('Historiske  program data fra blandeanlµg');
>    FindOgListFiler('Program fil fra ','./log/program*.html');
>    PrintFooter;
>  end;
>  if pos('AlarmLog',QUERY_STRING)<>0 then
>  begin
>    PrintHeader('Historiske  alarm log data fra blandeanlµg');
>    FindOgListFiler('Alarm log fil fra ','./log/alarmlog*.html');
>    PrintFooter;
>  end;
> end.
>
>
>
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20100519/75628b92/attachment.html>