unit CuLCGIu;

interface

uses
  SysUtils, Classes, Windows, HTTPApp, HTTPProd, IdBaseComponent, IdIntercept,
  IdLogBase, IdLogDebug, UtlType, PropUtl, WinUtl, UlanType, DLLUtl,
  IdComponent, IdIPWatch;

type
  TWebModule1 = class(TWebModule)
    IdLogDebug1: TIdLogDebug;
    PageProducer1: TPageProducer;
    procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure WebModuleCreate(Sender: TObject);
  private
    { Private declarations }
    //inp: TStringList;
    //FCHROMuLANMessage: integer;
    //FSharedMem: TSharedMem;
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

procedure CGIEnvUpdate;

procedure CGISetEnv(const PathInfo: string; const PathTranslated: string;
  const Query: string);

implementation

{$R *.DFM}
{setenvironmentalvariable}
const
  CGIServerVariables: array[0..28] of string = (
    'REQUEST_METHOD',
    'SERVER_PROTOCOL',
    'URL',
    'QUERY_STRING',
    'PATH_INFO',
    'PATH_TRANSLATED',
    'HTTP_CACHE_CONTROL',
    'HTTP_DATE',
    'HTTP_ACCEPT',
    'HTTP_FROM',
    'HTTP_HOST',
    'HTTP_IF_MODIFIED_SINCE',
    'HTTP_REFERER',
    'HTTP_USER_AGENT',
    'HTTP_CONTENT_ENCODING',
    'HTTP_CONTENT_TYPE',
    'HTTP_CONTENT_LENGTH',
    'HTTP_CONTENT_VERSION',
    'HTTP_DERIVED_FROM',
    'HTTP_EXPIRES',
    'HTTP_TITLE',
    'REMOTE_ADDR',
    'REMOTE_HOST',
    'SCRIPT_NAME',
    'SERVER_PORT',
    '',
    'HTTP_CONNECTION',
    'HTTP_COOKIE',
    'HTTP_AUTHORIZATION');

  CGIDefValues: array[0..28] of string = (
    'GET', //REQUEST_METHOD=GET
    'HTTP/1.1', //SERVER_PROTOCOL=HTTP/1.1
    '', //URL=
    '', //QUERY_STRING=a=10&b=20
    '', //PATH_INFO=/aaa
    '', //PATH_TRANSLATED=c:\html\aaa
    '', //HTTP_CACHE_CONTROL=
    '', //HTTP_DATE=
    '', //HTTP_ACCEPT=image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*
    '', //HTTP_FROM=
    '127.0.0.1', //HTTP_HOST=127.0.0.1
    '', //HTTP_IF_MODIFIED_SINCE=
    '', //HTTP_REFERER=
    'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)', //HTTP_USER_AGENT=Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)
    '', //HTTP_CONTENT_ENCODING=
    '', //HTTP_CONTENT_TYPE=
    '', //HTTP_CONTENT_LENGTH=
    '', //HTTP_CONTENT_VERSION=
    '', //HTTP_DERIVED_FROM=
    '', //HTTP_EXPIRES=
    '', //HTTP_TITLE=
    '127.0.0.1', //REMOTE_ADDR=127.0.0.1
    '', //REMOTE_HOST=
    '', //SCRIPT_NAME=/cgi-bin/CULCGI.exe
    '80', //SERVER_PORT=80
    '', //=
    'Keep-Alive', //HTTP_CONNECTION=Keep-Alive
    '', //HTTP_COOKIE=
    '' //HTTP_AUTHORIZATION=
    );

procedure CGISetEnv(const PathInfo: string; const PathTranslated: string;
  const Query: string);
var
  i: integer;
begin
  for i := low(CGIServerVariables) to high(CGIServerVariables) do begin
    SetEnv(CGIServerVariables[i], CGIDefValues[i]);
  end;
  SetEnv('PATH_INFO', PathInfo);
  SetEnv('PATH_TRANSLATED', PathTranslated);
  SetEnv('QUERY_STRING', Query);
end;

procedure CGIEnvUpdate;
var
  i: integer;
  s, p, q: string;
begin
  if ParamCount > 0 then begin
    s := '';
    for i := 1 to ParamCount do
      s := s + paramstr(i) + ' ';// connect eventually more parameters (space separated) to one
    i := pos('?', s);
    if i > 0 then begin
      //path and query:
      p := copy(s, 1, i - 1);
      q := copy(s, i + 1, length(s));
    end else begin
      //no query, only path:
      p := s;
      q := '';
    end;
    CGISetEnv(p, '', q);;
  end;
end;

procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
//  n: shortstring;
//  s: string;
  i: integer;
begin
  if CompareText(TagString, 'test') = 0 then begin
    {
    inp.Clear;
    reset(input);
    while not eof(input) do begin
      readln(input, s);
      inp.Add(s)
    end;
    closefile(input);
    }
    //i := 0;
    ReplaceText := 'CGI Env Vars: <br />'#13#10;
    if Request <> nil then begin
      for i := low(CGIServerVariables) to high(CGIServerVariables) do begin
        ReplaceText := ReplaceText + CGIServerVariables[i] + '=' +
          GetEnv(CGIServerVariables[i]) + '<br />' + #13#10;
      end;
     {while ClassGetPropNameAndValue(Request, i, n, s) do begin
        ReplaceText := ReplaceText + ' ' + n + '=' + s + '<br />'+ #13#10;
        inc(i);
      end;}
        ReplaceText := ReplaceText + 'Command line params: <br />'#13#10;
      if paramcount <> 0 then begin
        for i := 0 to paramcount do begin
          ReplaceText := ReplaceText + '%' + IntToStr(i) + '=' + ParamStr(i) + '<br />'#13#10;
        end;
      end;
      ReplaceText := ReplaceText + 'end';
    end;
   {inp.Text;}
  end;
end;

var
  FWebRequestAnswer: TWebRequestAnswer;
  Fptr: pointer absolute FWebRequestAnswer;

  FCuLWebHandle: THandle;
  FCuLWebDLLDir: shortstring;
  // = 'C:\Program Files\CHROMuLAN\';

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
{  l: TStringList;
  r, a: PShortString;
  fn: string;

  h: integer;
  sm: PCuLGlobalMem;}
  l: TStringList;
  fn: string;
  FCuLWebDLLFullName: string;
begin
  // Response.Content := PageProducer1.Content;
  l := TStringList.Create;

  try // dllutl findwindow
{
    sm := PCuLGlobalMem(FSharedMem.Mem);
    h := FSharedMem.Inc(@sm.Head, 1, CuLGlobalStringCount);
    r := @sm.Strings[h];
    r^ := Request.RemoteAddr + ' ' + Request.Query;
    a := PShortString(SendMessage(HWND_BROADCAST, FCHROMuLANMessage, culWebRequestAnswer, integer(r)));
}
    if not Assigned(FWebRequestAnswer) then begin
      FCuLWebDLLFullName := FileSearch(CuLWebDLLName, '.;' + FCuLWebDLLDir);
      if FCuLWebDLLFullName = '' then begin
        // not found, assign ini dir so that it can be adjusted (reported as error)
        FCuLWebDLLFullName := FCuLWebDLLDir + CuLWebDLLName;
      end;
      if DLLLoad(FCuLWebDLLFullName, false, FCuLWebHandle) then begin
        DLLAssignProc(Fptr, FCuLWebHandle, 'WebRequestAnswer', false);
      end;
    end;

    if not Assigned(FWebRequestAnswer) then begin
      l.Add('<html><head><title>Error</title></head><body>');
      l.Add(FCulWebDLLFullName + ' not found.');
      l.Add('</body></html>');
    end else begin
      fn := FWebRequestAnswer(Request.RemoteAddr, Request.Query);
      if FileExists(fn){r = a} then begin
        l.LoadFromFile(fn);
        DeleteFile(PChar(fn));
        Response.Content := l.Text;
      end else begin
        l.Add('<html><head><title>Error</title></head><body>');
        l.Add('WebRequestAnswer(' + Request.RemoteAddr + ', ' +
          Request.Query +') returned nothing.');
        l.Add('</body></html>');
        Response.Content := l.Text;
      end;
    end;
  finally
    l.Free;
  end;
end;

procedure TWebModule1.WebModuleCreate(Sender: TObject);
begin
//  inp := TStringList.Create;
//  FCHROMuLANMessage:= RegisterWindowMessage('CHROMuLAN');
//  FSharedMem := TSharedMem.Create(Self);
//  FSharedMem.MemName := CHROMuLANName;
//  FSharedMem.MemSize := sizeof(TCuLGlobalMem);
//  FSharedMem.Active := True;
end;

initialization
  FWebRequestAnswer := nil;
  FCuLWebHandle := 0;
  FCuLWebDLLDir := {v0.68}'';{'C:\Program Files\Apache Group\Apache\cgi-bin\;}
    {/v0.68 'C:\Program Files\CHROMuLAN\';}
  ConfigReadWriteValue(nil, rwRead, 'Env', 'CuLWebDLLDir', @FCuLWebDLLDir, ptString);

finalization
  if FCuLWebHandle <> 0 then begin
    DLLFree(FCuLWebHandle);
  end;
  ConfigReadWriteValue(nil, rwWrite, 'Env', 'CuLWebDLLDir', @FCuLWebDLLDir, ptString);
end.
