Hallo,

einem Tutorial für ISAPI WebServer Module (von Assarbad) folgend habe ich eine ISAPI DLL zusammengeschustert und meinem Apache klar gemacht, dass er mit dieser arbeiten soll. Nach einigen erfolgreichen Testläufen hab ich diese nach OOP umgestellt, jedoch scheiterts jetzt irgendwie ein wenig:

markieren

Code:

    ...

      // *****************************
      TQueryRequestFullfillerClass = class
      // *****************************
        constructor Create (var pECB: TEXTENSION_CONTROL_BLOCK);
      private
        Response:   Array[0..MAX_PATH] of Char;
        AllParams:  TParamStrings;
        dwLen:      Cardinal;

        Page,
        QueryString: WideString;

        ...
      public
        function SendResponse (var pECB: TEXTENSION_CONTROL_BLOCK): Integer;
      end;

      // *****************************
      THoroscopeRequestFullfillerClass = class (TQueryRequestFullfillerClass)
      // *****************************
      private
        ...
      public
        function ProcessRequest (var pECB: TEXTENSION_CONTROL_BLOCK): Integer;
      end;

    ...

    // *****************************
    constructor TQueryRequestFullfillerClass.Create (var pECB: TEXTENSION_CONTROL_BLOCK);
    // *****************************
    begin
      if (lstrcmpi (pECB.lpszMethod, 'POST') = 0) then
        begin
          SetString (QueryString, PChar(pECB.lpbData), pECB.cbTotalBytes);
          AllParams := GetAllParams (QueryString);
        end;

      if (lstrcmpi (pECB.lpszMethod, 'GET') = 0) then
        begin
          SetString (QueryString, PChar (pECB.lpszQueryString), Length (pECB.lpszQueryString));
          AllParams := GetAllParams (QueryString);
        end;

      Page := '';
    end;

    // *****************************
    function TQueryRequestFullfillerClass.SendResponse (var pECB: TEXTENSION_CONTROL_BLOCK): Integer;
    // *****************************
    begin
      Page := 'Content-Type: text/html' + #13#10#13#10 + Page;
      dwLen := lStrLen (@Page[1]);
      lstrcpy (Response, '200 OK');
      if pECB.ServerSupportFunction (pECB.ConnID, HSE_REQ_SEND_RESPONSE_HEADER, @Response, @dwLen, @page[1]) then
        Result := HSE_STATUS_SUCCESS
      else
        Result := HSE_STATUS_ERROR;
    end;

    // *****************************
    function THoroscopeRequestFullfillerClass.ProcessRequest (var pECB: TEXTENSION_CONTROL_BLOCK): Integer;
    // *****************************
    begin
      Page := '
[b]Hello World![/b]
';
      Result := SendResponse (pECB);
    end;

Das ist erst einmal der "Header" ...

Über die HttpExtensionProc erzeuge ich nun eine Instanz der Klasse THoroscopeRequestFullfillerClass, rufe die Funktion ProcessRequest auf und übergebe dabei den pECB-Parameter, der da wiederum weiterverarbeitet wird:

markieren

Code:

    // *****************************
    function HttpExtensionProc (var pECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall;
    // *****************************
    var
      QueryRequest: THoroscopeRequestFullfillerClass;
      Response: PChar;
      Page: String;
      dwLen: Integer;
    begin

      QueryRequest := THoroscopeRequestFullfillerClass.Create (pECB);
      Result := QueryRequest.ProcessRequest (pECB);
      QueryRequest.Free;

    end;

Was nun allerdings passiert ist, dass der Browser mir die DLL zum Download anbietet ... !? o_O

Allerdings gibts keine Probleme, wenn ich die Ausgabe nicht über das Objekt laufen lasse:

markieren

Code:

    // *****************************
    function HttpExtensionProc (var pECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall;
    // *****************************
    var
      QueryRequest: THoroscopeRequestFullfillerClass;
      Response: PChar;
      Page: String;
      dwLen: Integer;
    begin

      Page := 'Hello World!';

      Page := 'Content-Type: text/html' + #13#10#13#10 + Page;
      dwLen := lStrLen (@Page[1]);
      lstrcpy (Response, '200 OK');
      if pECB.ServerSupportFunction (pECB.ConnID, HSE_REQ_SEND_RESPONSE_HEADER, @Response, @dwLen, @page[1]) then
        Result := HSE_STATUS_SUCCESS
      else
        Result := HSE_STATUS_ERROR;

    end;

Jemand eine Idee, warum das nicht wie gedacht funktioniert?

(System: WinXP Prof, Apache 1.3.1, Delphi 6 DE Prof)

Grüße,
Mario

Hab eine Lösung gefunden:

Eine andere Methode, um dem Client die Daten zu schicken ist hierüber:

markieren

Code:

  ECB.dwHTTPStatusCode := 200;
 
  ResStr := Format(
    'HTTP/1.0 200 OK' + #13#10 +
    'Content-Type: text/html' + #13#10 +
    'Content-Length: %d' + #13#10 +
    'Content:' + #13#10#13#10 + '%s', [Length(Page), Page]);
 
  StrLen := Length (ResStr);
  if (ECB.WriteClient (ECB.ConnID, Pointer (ResStr), StrLen, 0)) then
    Result := HSE_STATUS_SUCCESS
  else Result := HSE_STATUS_ERROR;

Damit habe ich die im Tutorial verwendente Methode ersetzt und es tut nun, wie es soll. Ob es nun aber genau daran lag, weiss ich auch nicht (scheint aber so ...).

Viele Grüße,
Mario

markieren

Code:

    library CalcHoroscope;
     
    uses
      SysUtils,
      Classes,
      Windows,
      ISAPI2;

    type
      TParamStrings = Array of record
                                 Name,
                                 Value: WideString;
                               end;

      // *****************************
      TQueryRequestFullfillerClass = class
      // *****************************
        constructor Create (var ECB: TEXTENSION_CONTROL_BLOCK);
      private
        AllParams:  TParamStrings;

        Page,
        QueryString: WideString;

        function GetErrorPage (ErrCode: Integer): WideString;
        function DecodeSpaces (InputStr: WideString): WideString;
      public
        function SendResponse (var ECB: TEXTENSION_CONTROL_BLOCK): Integer;
      end;

      // *****************************
      THoroscopeRequestFullfillerClass = class (TQueryRequestFullfillerClass)
      // *****************************
      private
        Day, Month, Year,
        Hour, Minute, Second,

        LonDeg, LonMin, LonSec,
        LatDeg, LatMin, LatSec,

        UT_ET, EW, NS,

        BirthPlanet, Transits: Integer;

        HSys: Char;
      public
        function ProcessRequest (var ECB: TEXTENSION_CONTROL_BLOCK): Integer;
      end;

    const
      Description = 'CalcHoroscope ISAPI DLL';
      ERROR_PAGE = '<HTML><font face="Arial"><H2>Ein Fehler ist während der Bearbeitung der Anfrage aufgetreten:</H2>

%s</font>';
      LogPath    = 'C:\';
      LogFile    = LogPath + 'CalcHoroscope_ISAPI.log';

    {$i .\inc\HelpRoutines.pas}

    procedure AddToLog (LogFile, LogText: String);
    {$IFDEF LogActivities}
    var
      f: TextFile;
    {$ENDIF}
    begin
    {$IFDEF LogActivities}
      AssignFile (f, LogFile);
      if (FileExists (LogFile)) then
        Append (f)
      else Rewrite (f);

      WriteLn (f, '[' + DateTimeToStr (Now) + '] ' + LogText);

      CloseFile (f);
    {$ENDIF}
    end;

    (*)
     *  TQueryRequestFullfillerClass
    (*)

    // *****************************
    constructor TQueryRequestFullfillerClass.Create (var ECB: TEXTENSION_CONTROL_BLOCK);
    // *****************************
    begin
      AddToLog (LogFile, 'TQueryRequestFullfillerClass.Create');

      AddToLog (LogFile, '');

      AddToLog (LogFile, 'cbSize:         ' + inttostr (ECB.cbSize));
      AddToLog (LogFile, 'cbTotalBytes:   ' + inttostr (ECB.cbTotalBytes));
      AddToLog (LogFile, 'lpbData:        ' + PChar(ECB.lpbData));
      AddToLog (LogFile, 'lpszQueryString: ' + ECB.lpszQueryString);
      AddToLog (LogFile, 'cbAvailable:    ' + inttostr (ECB.cbAvailable));
      AddToLog (LogFile, 'ConnID:         ' + inttostr (ECB.ConnID));
      AddToLog (LogFile, 'Method:         ' + ECB.lpszMethod);

      if (lstrcmpi (ECB.lpszMethod, 'POST') = 0) then
        begin
          SetString (QueryString, PChar(ECB.lpbData), ECB.cbTotalBytes);
          AllParams := GetAllParams (QueryString);
        end;

      if (lstrcmpi (ECB.lpszMethod, 'GET') = 0) then
        begin
          SetString (QueryString, PChar (ECB.lpszQueryString), Length (ECB.lpszQueryString));
          AllParams := GetAllParams (QueryString);
        end;

      Page := '';
    end;

    // *****************************
    // Liefert eine Seite mit einer Fehlermeldung zurück
    function TQueryRequestFullfillerClass.GetErrorPage (ErrCode: Integer): WideString;
    // *****************************
    begin
      AddToLog (LogFile, 'TQueryRequestFullfillerClass.GetErrorPage: ' + inttostr (ErrCode));
      Result := frmt (ERROR_PAGE, [PChar (GetErrorMessage (ErrCode))]);
    end;

    // *****************************
    // Wandelt alle nötigen "+" in übergebenen URL-Strings in Leerzeichen um
    function TQueryRequestFullfillerClass.DecodeSpaces (InputStr: WideString): WideString;
    // *****************************
    var
      i: Integer;
      s: WideString;
    begin
      i := 1;
      s := InputStr;
      while i <= length(s) do
        case s[i] of
          '+':
            if (i + 1) <= length(s) then
              case s[i + 1] of
                '+':
                  begin
                    inc(i);
                    s[i] := ' ';
                    inc(i);
                  end;
              else
                begin
                  s[i] := ' ';
                  inc(i);
                end;
              end else
            begin
              s[i] := ' ';
              inc(i);
            end;
        else inc(i);
        end;
      Result := s;
    end;

    // *****************************
    function TQueryRequestFullfillerClass.SendResponse (var ECB: TEXTENSION_CONTROL_BLOCK): Integer;
    // *****************************
    var
      StrLen: Cardinal;
      ResStr: String;
    begin

      AddToLog (LogFile, 'TQueryRequestFullfillerClass.SendResponse');

    {
      AddToLog (LogFile, 'Page:');
      AddToLog (LogFile, Page);
    }

      ECB.dwHTTPStatusCode := 200;

      ResStr := Format(
        'HTTP/1.0 200 OK' + #13#10 +
        'Content-Type: text/html' + #13#10 +
        'Content-Length: %d' + #13#10 +
        'Content:' + #13#10#13#10 + '%s', [Length(Page), Page]);

      StrLen := Length (ResStr);
      if (ECB.WriteClient (ECB.ConnID, Pointer (ResStr), StrLen, 0)) then
        Result := HSE_STATUS_SUCCESS
      else Result := HSE_STATUS_ERROR;
    end;

    (*)
     *  TQueryRequestFullfillerClass
    (*)

    (*)
     *  THoroscopeRequestFullfillerClass
    (*)

    // *****************************
    function THoroscopeRequestFullfillerClass.ProcessRequest (var ECB: TEXTENSION_CONTROL_BLOCK): Integer;
    // *****************************
    begin
      Page := '
[b]Hello World![/b]
';

      Result := SendResponse (ECB);
    end;

    (*)
     *  THoroscopeRequestFullfillerClass
    (*)

    (*)
     *  Main
    (*)

    // *****************************
    // :: Zwingend benötigte Prozedur ::
    // Gibt die unterstützte ISAPI-Version und ebenfalls eine Kurzbeschreibung
    // der Extension, die in der Variable Description enthalten ist, an den
    // Server zurück
    function GetExtensionVersion(var pVer: THSE_VERSION_INFO): BOOL; stdcall;
    // *****************************
    begin
      pVer.dwExtensionVersion := MAKELONG(HSE_VERSION_MINOR, HSE_VERSION_MAJOR);
      pVer.lpszExtensionDesc := Description + #0;
      Result := TRUE;
    end;

    // *****************************
    // :: Zwingend benötigte Prozedur ::
    // Bearbeitet eine Anforderung
    function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall;
    // *****************************
    var
      QueryRequest: THoroscopeRequestFullfillerClass;

    begin

      AddToLog (LogFile, '=======================');
      AddToLog (LogFile, 'HttpExtensionProc Entry');

      ECB.lpszLogData := Description;

      QueryRequest := THoroscopeRequestFullfillerClass.Create (ECB);
      Result := QueryRequest.ProcessRequest (ECB);
      QueryRequest.Free;

      AddToLog (LogFile, 'HttpExtensionProc Leave');
      AddToLog (LogFile, '=======================');

    end;

    (*)
     *  Main
    (*)

    exports
      HttpExtensionProc,
      GetExtensionVersion;

    begin
    end.