Announcement

**Andreas Kosch** · 11.07.2003, 05:49

Hallo,

ja das ist m�glich. Dazu muss die DLL allerdings als klassiche DLL die vom IIS von einer ISAPI-DLL erwarteten exportierten Funktionen implementieren: 
a) GetExtensionVersion 
b) HttpExtensionProc

Weil aber eine derartige Umsetzung in C# keinen Sinn macht, kann ich nur mit einem Delphi-Beispiel dienen:
<pre>
{ ************************************************** **************
Source File Name : SQLDB.DPR
Typ : DLL-Projekt (ISAPI)
Autor : Andreas Kosch
Erstellt am : 01.06.98
Compiler : Delphi 3.02
Betriebssystem : Windows 95
Beschreibung : Generisches ISAPI-Modul f�r den Datenbank-
zugriff auf die SQLBase-Newsgroup-Datenbank.
Revisionen : -
************************************************** ************** }

library SQLDB;

uses
Windows, SysUtils, ISAPI, IniFiles, DB, DBTables, Classes;

{ exportierte ISAPI-Funktion GetExtensionVersion }

function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL; stdcall;
begin
Ver.dwExtensionVersion := $00010000; // 1.0 support
Ver.lpszExtensionDesc := 'Delphi 3.02 ISAPI DLL'; // Description
Result := True;
end ;

{ exportierte ISAPI-Funktion HttpExtensionProc mu� threadsicher sein,
d.h. es sind keine globalen Variablen f�r Daten zul�ssig. Daher wird
alles �ber den f�r jeden Thread separt g�ltigen Stack erledigt. }

function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall;
var
Data : AnsiString;
IniFile : String; // Pfad wird aus Alias-Verzeichnis ermittelt

{ Daten der zugeordneten Tabellenspalte auslesen }

function Value(const Field: ShortString): ShortString;
var
i: Integer;
len: Byte absolute Result;
begin
Len := 0;
i := Pos('&' + Field + '=',Data);
if i = 0 then begin
i := Pos(Field + '=',Data);
if i > 1 then i := 0
end
else Inc(i); // '&'-Zeichen �berspringen
if i > 0 then begin
Inc(i,Length(Field)+1);
while Data[i] <> '&' do begin
if not (Data[i] in [#10,#13]) then begin // CR/LF ignorieren
Inc(Len);
Result[Len] := Data[i]
end
else begin // CR/LF -> #32
if (Len = 0) or (Result[Len] <> #32) then begin
Inc(Len);
Result[Len] := #32
end
end;
Inc(i)
end
end;
while (Len > 0) and (Result[len] = #32) do Dec(len)
end;

{ Zeichenkette in Integerwert konvertieren }

function ValueAsInteger(const Field: ShortString): Integer;
begin
try
Result := StrToInt(Value(Field))
except
Result := 0
end
end;

procedure GenerateContents(var Str: String);

{ Buttonleiste generieren:
a) neuer Datensatz : POST, CANCEL
b) Anzeigemodus : FIRST, PREV, NEXT, LAST, INSERT, DELETE, REFRESH }

procedure DataSetTable(DataSet: TDataSet; NewRec: Boolean);
const
Int: array[1..9] of Char = '123456789';
var
i,j,col,items : Integer;
option : ShortString;
begin
if NewRec then begin
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Post>'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Cancel>'#13#10
end
else begin
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=First>'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Prev>'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Next>'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Last>'#13#10;
Str := Str + '&nbsp;'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Insert>'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Delete>'#13#10;
Str := Str + '&nbsp;'#13#10;
// Suchbutton z.Zt. auskommentiert
//Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Find>'#13#10;
//Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Query>'#13#10;
//Str := Str + '&nbsp;'#13#10;
Str := Str + '<INPUT TYPE=SUBMIT NAME=Action VALUE=Refresh>'#13#10;
end;
Str := Str + '<INPUT TYPE=RESET VALUE=Reset>'#13#10;
Str := Str + ''#13#10;
with DataSet do begin
if NewRec
// neuer Datensatz -> Autoincrementfeld ist unbekannt
then Str := Str + '<INPUT TYPE=HIDDEN NAME="' +
Fields[0].FieldName + '" VALUE="-1">'#13#10
// vorhandener Datensatz -> Prim�rschl�sselwert merken
else Str := Str + '<INPUT TYPE=HIDDEN NAME="' +
Fields[0].FieldName + '" VALUE="' +
Fields[0].AsString + '">'#13#10;
Str := Str + '<TABLE BGCOLOR=BBBBBB BORDER><TR>'#13#10;
col := 0;
// auf INI zugreifen
with TIniFile.Create(IniFile) do
try
// erste Spalte (Prim�rschl�ssel) ist versteckt
for i := 1 to FieldCount - 1 do begin
if Fields[i].DataType = ftMemo then begin
// Memofeld
Str := Str + '</TR><TR><TD COLSPAN=3>';
col := 3;
end
else
// kein Memofeld
if Fields[i].Size > 99 then begin
// langes Zeichenfeld
Inc(col,2);
if col > 3 then begin
Str := Str + '</TR><TR>';
col := 2
end;
Str := Str + '<TD COLSPAN=2>'
end
else begin
// kurzes Zeichenfeld
Inc(col);
if col > 3 then begin
Str := Str + '</TR>'#13#10'<TR>';
col := 1
end;
Str := Str + '<TD>'
end;
Str := Str + '' + ReadString(Fields[i].FieldName, 'Name',
Fields[i].FieldName) + ' ';
// Eintr�ge zu dieser Tabellenspalte in der INI ?
items := ReadInteger(Fields[i].FieldName,'Items',0);
if items = 0 then begin
// kein Eintrag in der INI
if Fields[i].DataType = ftMemo then begin
Str := Str + '<TEXTAREA NAME="' + Fields[i].FieldName +
'" ROWS=18 COLS=80>';
if not NewRec then
Str := Str + Fields[i].AsString;
Str := Str + '</TEXTAREA>'
end
else begin
// kein Memo -> wie gro� ist das Feld ?
if Fields[i].Size > 99 then
Str := Str + '<INPUT TYPE=text NAME="' +
Fields[i].FieldName + '" SIZE=64'
else
if Fields[i].Size = 0 then
Str := Str + '<INPUT TYPE=text NAME="' +
Fields[i].FieldName + '" SIZE=30'
else
Str := Str + '<INPUT TYPE=text NAME="' +
Fields[i].FieldName + '" SIZE=' +
IntToStr(Fields[i].Size);
if not NewRec then
Str := Str + ' VALUE="' + Fields[i].AsString + '"';
Str := Str + '>'
end
end
else begin
// Eintrag in der INI vorhanden !
Str := Str + '<SELECT NAME="' + Fields[i].FieldName + '">';
for j:=1 to items do begin
option := ReadString(Fields[i].FieldName,
'Item' + Int[j], Int[j]);
if (not NewRec) and (option = Fields[i].AsString) then { selected }
Str := Str + '<OPTION SELECTED VALUE="' + option +
'">' + option + ' '
else
Str := Str + '<OPTION VALUE="' + option + '">' + option + ' '
end;
Str := Str + '</SELECT>'
end;
Str := Str + '</TD>'
end;
Str := Str + '</TR>'#13#10
finally
Str := Str + '</TABLE>'#13#10;
Free
end
end
end;

{ Pfad der INI-Datei aus den Alias-Daten auslesen }

function GetAliasPath(const Alias: string): string;
var
ParamList: TStringList;
begin
ParamList:=TStringList.Create;
try
Session.GetAliasParams(Alias, ParamList);
Result:=ParamList.Values['PATH'];
finally
ParamList.Free;
end;
end;

// Hauptteil von procedure GenerateContents(var Str: String);
const
_DatabaseName = 'CgiSQL'; // Aliasname der BDE
_TableName = 'sqlmemo.db'; // Tabellenname
Action: String[7] = '';
var
Table: TTable;
Session: TSession; // Multithreading-BDE
iPrimaryKey,i: Integer; // Prim�rschl�sselfeld
NoChange: Boolean;
begin
Str := '';
Action := '';
ShortDateFormat := 'DD.MM.YYYY';
// neue Session f�r die BDE anlegen (Multithreading)
Session := TSession.Create(nil);
Session.AutosessionName := True;
Session.Active := True;
// neue TTable-Instanz anlegen, verwendet die neue Session
Table := TTable.Create(nil);
Table.SessionName := Session.SessionName;
with Table do
try
Active := False;
TableType := ttParadox;
DatabaseName := _DatabaseName; // Zugriff �ber Aliasname
TableName := _TableName;
Open; // Datenbanktabelle �ffnen
// Kopf der Startseite zusammenbauen
IniFile := GetAliasPath(_DatabaseName) + '\sqldb.ini';
Str := '<HTML>'#13#10;
with TIniFile.Create(IniFile) do
try
Str := Str + '<HEAD>'#13#10;
Str := Str + '<TITLE>' + ReadString(_TableName,'Name','') +
'</TITLE>'#13#10;
Str := Str + '</HEAD>'#13#10;
Str := Str + '<BODY BGCOLOR=AAAAAA>'#13#10;
Str := Str + '<CENTER>'#13#10;
Str := Str + '<H1>';
Str := Str + '<IMG SRC="' + ReadString(_TableName,'Bitmap','') + '">';
Str := Str + ReadString(_TableName, 'Name', '');
Str := Str + '</H1>'#13#10;
Str := Str + '<FORM METHOD=POST ACTION="' +
ReadString(_TableName, 'Action', '') + '">'#13#10
finally
Free
end;
First;
// �bergebenen Prim�rschl�ssel ermitteln und suchen
iPrimaryKey := ValueAsInteger('RecID');
if iPrimaryKey > 0
then FindKey([iPrimaryKey])
else First;
// auszuf�hrende Aktion bestimmen
if Action = ''
then Action := Value('Action');
if Action = ''
then Action := 'First';
// ausf�hren
if Action = 'First'
then First
else if Action = 'Next'
then Next
else if Action = 'Prev'
then Prior
else if Action = 'Last'
then Last
else if (Action = 'Find') or (Action = 'Query')
then begin
// ToDo: spezielles Suchformular
end
else if Action = 'Delete'
then Delete
else if Action = 'Insert'
then // �berspringen
else if Action = 'Post'
then begin
First;
iPrimaryKey := 0;
while not Eof do begin
if Fields[0].AsInteger > iPrimaryKey
then iPrimaryKey := Fields[0].AsInteger;
Next
end;
Inc(iPrimaryKey);
Insert;
Fields[0].AsInteger := iPrimaryKey;
for i := 1 to FieldCount - 1 do
Fields[i].AsString := Value(Fields[i].FieldName);
Post
end
else if Action = 'Cancel'
then
else;
Str := Str + '' + Action + '';
// HTML-Formular mit den Datenfeldern generieren
DataSetTable(Table,Action = 'Insert');
Close
finally
Str := Str + '</FORM>'#13#10;
Str := Str + '</BODY>'#13#10;
Str := Str + '</HTML>'#13#10;
Free
end;
Session.Free; // Session wieder freigeben
Session := nil;
Table := nil // TTable wieder freigeben
end;

// Hauptteil von function HttpExtensionProc
var
i : Integer;
Str : AnsiString;
begin
Str := '';
try
try
// ECB input data
if StrPas(ECB.lpszMethod) = 'POST'
then Data := StrPas(ECB.lpbData)
else Data := ECB.lpszQueryString;
if (Length(Data) > 1) and
(Data[Length(Data)] = #0) then Delete(Data,Length(Data),1);
i := 0;
while i < Length(Data) do begin
Inc(i);
if Data[i] = '+' then Data[i] := ' ';
if Data[i] = '%' then begin
// Sonderzeichen
Str := '$00';
Str[2] := Data[i+1];
Str[3] := Data[i+2];
Delete(Data,i+1,2);
Data[i] := Chr(StrToInt(Str))
end
end;
if i > 0
then Data[i+1] := '&'
else Data := '&';
// ECB output data initialisieren
ECB.lpszLogData := 'SQLMemo - die Newsgroupdatenbank';
ECB.dwHTTPStatusCode := 200;
// HTML-Seite dynamisch erstellen
try
GenerateContents(Str);
except
on E: Exception do
Str := Str + 'IN<HR>&lt ;P>' + E.ClassName + ' ' + E.Message
end;
except
on E: Exception do
Str := Str + 'OUT<HR>&l t;P>' + E.ClassName + ' ' + E.Message
end;
finally
// ECB output data zusammenstellen
Str := 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(Str), Str]);
i := Length(Str);
ECB.WriteClient(ECB.ConnID, Pointer(Str), i, 0)
end;
Result := HSE_STATUS_SUCCESS
end;

exports
GetExtensionVersion,
HttpExtensionProc;

begin
IsMultiThread := True; // Sessions der BDE !!!
end.
</pre&gt

Announcement

DLL statt aspx im IIS Starten?

DLL statt aspx im IIS Starten?

Comment