[fpc-pascal] CGI application

Wed May 19 15:19:00 CEST 2010

> 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.