|
Delphi Data Module Code:
unit dm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
bcISAPIFilter, bcLog, DBTables, Db, SyncObjs;
type
TdmLogin = class(TDataModule)
bcLog: TbcLog;
bcISAPIFilter: TbcISAPIFilter;
Query: TQuery;
Database: TDatabase;
procedure bcISAPIFilterAfterProcessGetFilterVersion(Sender: TObject;
var Version: THTTP_FILTER_VERSION; var Result: LongBool);
procedure bcISAPIFilterAuthentication(Sender: TObject;
pfcObject: THttpFiltCtx; var AuthentStruct: THTTP_FILTER_AUTHENT;
var RetVal: Cardinal);
procedure dmLoginCreate(Sender: TObject);
procedure dmLoginDestroy(Sender: TObject);
procedure bcISAPIFilterException(Sender: TObject; E: Exception);
private
public
DatabaseName : string;
SQL : string;
//input ussername and pass and their Win NT equivalents
Login, Pass, MappedLogin, MappedPass : string;
//previous query results to be used as a cache.
LastLogin, LastPass : string;
LastIsOK : boolean;
CriticalSection : TCriticalSection; //to protect above variables.
end;
var
dmLogin: TdmLogin;
implementation
uses IniFiles;
{$R *.DFM}
//------------------------------------------------------------------------------
{
This DLL will register itself with IIS to receive authentication notifications.
The function that the IIS calls to learn which notifications the DLL is
interested in is called 'GetFilterVersion' and in this case it is supplied by the
bcISAPIFilter unit. You do not have to write it.
The function that IIS calls whenever it wants to notify the DLL is called
'HttpFilterProc'. This function is also supplied by the bcISAPIFilter unit. You
do not have to write it.
IIS will pass the original username and password to the HttpFilterProc function.
This function will call your component's TbcISAPIFilter.HttpFilterProc() method
with appropriate information. TbcISAPIFilter.HttpFilterProc() method will call
the event handler that you write below as TdmLogin.bcISAPIFilterAuthentication().
Inside your event handler, you can check the user supplied username and password, and
replace them to other valid or invalid values after looking up in a mapping database
which could simply be a flat file, or SQL Server, or anything else that works for you.
This example was tested with an MS Access Database which had an
ODBC Datasource Name as 'PASS'.
}
procedure TdmLogin.bcISAPIFilterAfterProcessGetFilterVersion(
Sender: TObject; var Version: THTTP_FILTER_VERSION;
var Result: LongBool);
var
hModule : THANDLE;
pszDLL: array[0..1023] of char; //assuming the path to dll will be shorter than 1024 chars.
Path : string;
begin
hModule := GetModuleHandle('bcLoginFilter.dll');
if not (GetModuleFileName(hModule, pszDLL, 1023) > 0) then //1023 buffer length should be enough
begin
//Result:= false; //tell to unload the filter, we cannot operate.
raise EISAPIException.Create('Could not find DLL module name.', MUST_EXIT);
end;
Path:= ExtractFilePath(string(pszDLL));
bcLog.LogFileName := Path + 'bcLoginFilter.log';
//read initial settings as the dll starts:
with TIniFile.Create(Path + 'bcLoginFilter.ini') do
begin
//read the ODBC or BDE alias that represents the database which we are interested in
DatabaseName := ReadString('Settings', 'DatabaseName', 'PASS');
SQL:= ReadString('Settings', 'SQL', 'SELECT NTLogin, NTPass FROM PASS WHERE empLogin = :login AND empPass = :password');
Free; //TIniFile.Free
end;
Database.Databasename:= DatabaseName;
Query.DatabaseName:= DatabaseName;
Query.SQL.Add(SQL);
Query.RequestLive := false;
//Prepare once, so that each database lookup will be faster when we call
//Query.Open for each authentication request:
Query.Prepare;
//debugging
bcLog.LogInfo(SQL);
end;
//------------------------------------------------------------------------------
procedure TdmLogin.bcISAPIFilterAuthentication(Sender: TObject;
pfcObject: THttpFiltCtx; var AuthentStruct: THTTP_FILTER_AUTHENT;
var RetVal: Cardinal);
begin
(* //for reference:
typedef struct _HTTP_FILTER_AUTHENT{
CHAR* pszUser; //IN/OUT
DWORD cbUserBuff; //IN
CHAR* pszPassword; //IN/OUT
DWORD cbPasswordBuff; //IN} HTTP_FILTER_AUTHENT
*)
if not ( (lstrlen(AuthentStruct.pszUser)>0) and (lstrlen(AuthentStruct.pszPassword)>0) ) then
exit;
CriticalSection.Enter; //protect the below code from multiple threads in IIS.
try
Login := AuthentStruct.pszUser;
Pass := AuthentStruct.pszPassword;
//be aware that once the user logs in, if noone else logs in afterwards,
//and user is deleted from the database loosing the correct credentials,
//he/she will still be granted access in this version of handling this.
if LastIsOK and
(AnsiCompareText(Login, LastLogin) = 0) and
(AnsiCompareText(Pass, LastPass) = 0) then
begin
//In this dll it is guaranteed that MappedLogin matches Login at this point.
//CriticalSection makes sure that LastIsOk, Login, and MappedLogin are changed
//at the same critical section so there is no way that another thread can change
//MappedLogin after we decide LastIsOk.
lstrcpy(AuthentStruct.pszUser, PChar(MappedLogin));
lstrcpy(AuthentStruct.pszPassword, PChar(MappedPass));
end
else
begin//if last login is not the same and correct
{
Query.ParamByName('login').AsString := Login;
Query.ParamByName('password').AsString:= Pass;
}
//Assuming the following Parameter order:
Query.Params[0].AsString := Login;
Query.Params[1].AsString := Pass;
//Query was prepared at DLL initialization.
//So Query should run quick:
Query.Open; //retrieve values from database
if not Query.EOF then
begin
MappedLogin:= Query.Fields[0].AsString;
MappedPass:= Query.Fields[1].AsString;
lstrcpy(AuthentStruct.pszUser, PChar(MappedLogin) );
lstrcpy(AuthentStruct.pszPassword, PChar(MappedPass) );
LastLogin:= Login;
LastPass:= Pass;
LastIsOK:= true;
bcLog.LogInfo('User name retrieved from database.');
end else begin
LastIsOK:= false;
end;
end;
//debugging
//bcLog.LogInfo('OnAuthentication is exiting OK');
finally
Query.Close; //should be kept closed when not processing,
//or Query.Open will give error.
CriticalSection.Leave; //Exit critical section even if there is an exception.
end;
end;
//------------------------------------------------------------------------------
procedure TdmLogin.dmLoginCreate(Sender: TObject);
begin
CriticalSection:= TCriticalSection.Create;
LastIsOK:= false;
end;
//------------------------------------------------------------------------------
procedure TdmLogin.dmLoginDestroy(Sender: TObject);
begin
CriticalSection.Free;
end;
//------------------------------------------------------------------------------
procedure TdmLogin.bcISAPIFilterException(Sender: TObject; E: Exception);
begin
CriticalSection.Enter; //protect the log file from multiple threads
bcLog.LogInfo('An exception occured: ' + E.Message);
CriticalSection.Leave;
end;
end.
|
