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 <cars...@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@lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
