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.