I really like the TWebUserList component that comes with Delphi 6/WebSnap. I
especially love the concept of Access
Rights. But let's face it -- for most of
us, this data can't be stored in memory. It needs to be stored in a database. The
obvious way to solve this problem is to write a validation routine in each
application in the OnBeforeCheckAccessRights and OnBeforeValidateUser events.
But who wants to do that, when we have the RAD power of Delphi? Fortunately,
writing our own component to encapsulate this functionality is easy.
Finishing Up
Finishing up already? Well, yes...all the work has already been done for you.
All you have to do is download
the WebSnap
Pack components and start using the TDBWebUserList. Of course, if you want to know how
it works, you'll have to keep reading! (And please, send me a post card, would
you? Thanks.)
To install, just unzip the the downloaded files into a
directory, open DBWebUserLists.dpk and click the "install" button.
To use the component,
open or create a WebSnap application. Drop the component on the Web App Page
Module, set the DataSet property to
a query that will return the User's Unique ID, Username (Display Name), Password, and Rights fields. Fill in the
field name properties so that they correspond with fields in the database. Next, select the WebAppComponents
component and set the UserListService
property to the DBWebUserList component.
Congratulations! You may now begin validating users through a database! No
need for writing event handlers to do validation -- everything is done for you. Of course, the
event handlers are still there if you need
them.
Designing TDBWebUserList
A Web User List can be any component that implements the IWebUserList
interface, which is defined in the SiteComp.pas unit:
IWebUserList = interface
['{0877DEAF-AB5D-11D4-A503-00C04F6BB853}']
function ValidateUser(Strings: TStrings): Variant;
function CheckAccessRights(UserID: Variant; Rights: string): Boolean;
end;
Unfortunately, there is a problem with this interface -- it provides no
way to get the user's display name! If you have ever tried to put
EndUser.DisplayName in one of your WebSnap pages, you know that it doesn't get
the display name -- it gets the User ID! So let's expand this interface so that
we can retrieve the user's display name:
IudWebUserList = interface(IWebUserList)
['{0C7E6E80-3F82-47C6-B37E-04BEA4FAEE4A}']
function UserDisplayName(AUserID: variant): string;
end;
Our component will use the interface so we can go back
and update the EndUserSessionAdapter in a later article.
You can go ahead and download the TudEndUserSessionAdapter
from the WebSnap
Pack. Keep tabs on the Community page
for an article about it.
A great new feature of Delphi 6 is that interfaces can be published
properties. That means we don't have to inherit from TCustomWebUserList (though
we can, of course) -- all we have to do is implement the IWebUserList and Delphi
6 will allow our component to be a Web User List no matter what it is descended
from. Here's the declaration of TDBWebUserList:
TDBWebUserList = class(TComponent, IWebUserList, IudWebUserList)
private
FOnAfterCheckAccessRights: TCheckAccessRightsEvent;
FOnBeforeCheckAccessRights: TCheckAccessRightsHandledEvent;
FOnUserIDNotFound: TCheckAccessRightsHandledEvent;
FOnAfterValidateUser: TValidateUserEvent;
FOnBeforeValidateUser: TValidateUserHandledEvent;
FOnValidateUserError: TValidateUserErrorEvent;
FUserIDFieldName: string;
FUserNameFieldName: string;
FRightsFieldName: string;
FPasswordFieldName: string;
FDataSet: TDataSet;
function UserName: string;
function UserID: string;
function Password: string;
function Rights: string;
procedure SetDataSet(const Value: TDataSet);
protected
function UserByID(AUserID: variant): IudWebUser;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
{ IudWebUserList }
function ValidateUser(Strings: TStrings): Variant;
function CheckAccessRights(AUserID: variant; ARights: string): Boolean;
function UserDisplayName(AUserID: variant): string;
published
property UserIDFieldName: string
read FUserIDFieldName write FUserIDFieldName;
property UserNameFieldName: string
read FUserNameFieldName write FUserNameFieldName;
property PasswordFieldName: string
read FPasswordFieldName write FPasswordFieldName;
property RightsFieldName: string
read FRightsFieldName write FRightsFieldName;
property DataSet: TDataSet
read FDataSet write SetDataSet;
property OnBeforeCheckAccessRights: TCheckAccessRightsHandledEvent
read FOnBeforeCheckAccessRights write FOnBeforeCheckAccessRights;
property OnAfterCheckAccessRights: TCheckAccessRightsEvent
read FOnAfterCheckAccessRights write FOnAfterCheckAccessRights;
property OnUserIDNotFound: TCheckAccessRightsHandledEvent
read FOnUserIDNotFound write FOnUserIDNotFound;
property OnBeforeValidateUser: TValidateUserHandledEvent
read FOnBeforeValidateUser write FOnBeforeValidateUser;
property OnAfterValidateUser: TValidateUserEvent
read FOnAfterValidateUser write FOnAfterValidateUser;
property OnValidateUserError: TValidateUserErrorEvent
read FOnValidateUserError write FOnValidateUserError;
end;
If you take a look at the source for TWebUserList, you'll notice that the
components are quite similar. We've added the UserDisplayName function from the IudWebUserList
interface, a DataSet property, and some string properties so we know which
fields in the DataSet to access. Also, because we will be interacting with
another component (a TDataSet component), we need to know if and when that other
component is freed, so we need to override the Notification procedure of
TComponent.
IudWebUserList Interface
The first part of the source is the implementation we'll go over is the IudWebUserList
interface implementation. We'll begin with the CheckAccessRights function which
has the purpose of determining weather or not a given user has a
given access right. Most of the code for this function was taken straight from Borland's
WebSnap source. However there are a few modifications that allow us to use the
IudWebUser interface instead of a collection item. Here is the source for
CheckAccessRights:
function TDBWebUserList.CheckAccessRights(AUserID: Variant;
ARights: string): Boolean;
var
Item: IudWebUser;
Handled: Boolean;
begin
Handled := False;
if Assigned(OnBeforeCheckAccessRights) then // Let the programmer handle
OnBeforeCheckAccessRights(AUserID, ARights, Result, Handled); // this event
if not Handled then
begin { Automatically handle Access Rights validation }
if ARights = '' then
Result := True // Checking for blank rights, just let 'em thorough
else if VarIsEmpty(AUserID) then
Result := False // Make sure the user is logged in!
else begin
Item := UserByID(AUserID); // Get the user from the database
if not VarIsEmpty(AUserID) then
Result := Item.CheckRights(ARights) // Verify access rights
else begin
if Assigned(OnUserIDNotFound) then // User not found, fire event!
OnUserIDNotFound(AUserID, ARights, Result, Handled);
if not Handled then // If event was not not handled, raise exception
raise EUserIDNotFoundException.Create(sUserIDNotFound);
end;
end;
end;
if Assigned(OnAfterCheckAccessRights) then // Rights check complete
OnAfterCheckAccessRights(AUserID, ARights, Result); // fire the event.
end;
Before executing the default behavior, we want to give the programmer a
chance to do processing or handle the access-rights checking. To do that we
fire the OnBeforeCheckAccessRights event. If the programmer sets Handled to
True, we assume that the default behavior is not necessary.
Following the default behavior logic should be pretty simple. If the rights
in question are blank, let them pass. Otherwise, if no user was given, they
don't pass. Finally, if neither of the previous two conditions is met, we
simply verify that the user exists and if the user exists, make sure that he
has the rights in question by calling CheckRights (which we will go over later).
Next is the ValidateUser function which takes a TStrings parameter and verifies that the given strings match
values in the database. If we succeed, we return the User ID, if we fail we
return nil. Here is the code:
function TDBWebUserList.ValidateUser(Strings: TStrings): Variant;
var
Item: IudWebUser;
Handled: Boolean;
begin
Handled := False;
if Assigned(OnBeforeValidateUser) then // Allow programmer to
OnBeforeValidateUser(Strings, Result, Handled); // handle validation
if not Handled then
begin { Automatically Handle Validation for programmer }
if Strings.IndexOfName(sWebUserName) >= 0 then
begin
Item := UserByID(Strings.Values[sWebUserName]); // Get user from DB
if not VarIsClear(Item) then { Thanks, Antonis Mylonas }
begin { The user was found, validate the user... }
Result := Item.UserID;
WebContext.Session.Values[sUserName] := Item.UserName;
if Item.Password <> '' then
begin { If the password in the DB is blank, they pass. Otherwise... }
if Strings.IndexOfName(sWebUserPassword) >= 0 then
begin { Check the given password against the one in the database }
if not (Strings.Values[sWebUserPassword] = Item.Password) then
begin { Wrong password! }
if Assigned(OnValidateUserError) then
OnValidateUserError(vuBlankPassword, Strings, Result, Handled);
if not Handled then
raise EValidateUserException.Create(sInvalidPassword);
end;
end else begin
{ Password NOT given! }
if Assigned(OnValidateUserError) then
OnValidateUserError(vuBlankPassword, Strings, Result, Handled);
if not Handled then
raise EValidateUserException.Create(sMissingPassword);
end;
end;
end else begin
{ User was NOT found! }
if Assigned(OnValidateUserError) then // Let programmer handle error
OnValidateUserError(vuUnknownUserName, Strings, Result, Handled);
if not Handled then // Or handle it ourselves
raise EValidateUserException.Create(sUnknownUserName);
end;
end else begin
{ User name was NOT found! }
if Assigned(OnValidateUserError) then // Let programmer handle error
OnValidateUserError(vuBlankUserName, Strings, Result, Handled);
if not Handled then // Or handle it ourselves
raise EValidateUserException.Create(sMissingUserName);
end;
end;
if Assigned(OnAfterValidateUser) then // Validation complete, fire the
OnAfterValidateUser(Strings, Result); // corresponding event.
end;
Once again, we give the programmer the opportunity to do processing or
handle the validation. Assuming the programmer does not set handled to true, we
perform the default behavior. As with CheckAccessRights, most of this
code was simply copied and pasted from Borland's code and modified to use
IudWebUser. (I also cleaned up the code formatting. The way Borland wrote the
code was difficult to read IMHO.)
When executing the default behavior, we can expect the Strings object to
contain at least a user name and password. Any other values it contains are none
of our concern. If no user name is given, we cannot validate the user so we fire
the OnValidateUserError event so that the programmer can handle the error. If
the error goes unhandled, we raise an EValidateUserException, which eventually
gets handled by WebSnap. If the user is validated, we set a session variable to
contain the user's display name -- more on this in the next article.
The rest of the logic is like any other validation routine. You may want to
take a minute to
look at the source and read the comments.
Finally, let's go over our addition: the UserDisplayName function. This is a
very simple function which takes in a user's ID and returns the associated
display name:
function TDBWebUserList.UserDisplayName(AUserID: variant): string;
var
UserItem: IudWebUser;
begin
UserItem := UserByID(AUserID);
Result := UserItem.UserName;
end;
This just calls the UserByID function to get an IudWebUser in return. It is
then a trivial task to return the Display Name.
Assigning the DataSet
There are two important things to note when assigning the DataSet property:
- We have to know when the DataSet is freed, to avoid access violations.
- The DataSet may be on a different module than the TDBWebUserList, so just
overriding the Notification procedure is not enough.
So let's take a look at the SetDataSet and Notification procedures:
procedure TDBWebUserList.SetDataSet(const Value: TDataSet);
begin
FDataSet := Value;
FDataSet.FreeNotification(Self);
end;
procedure TDBWebUserList.Notification(AComponent: TComponent; Operation:
TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDataSet) then
FDataSet := nil;
end;
When we set the DataSet in the SetDataSet procedure, we call the
FreeNotification procedure and pass "Self" as the parameter. Now we
are registered to receive "Notification" when the DataSet is removed.
In the Notification procedure, we set our DataSet to nil if the DataSet
we were pointing to was removed.
IudWebUser and TDBWebUser
You may be wondering about the IudWebUser interface that's been showing up in
the code. Well, here it is:
IudWebUser = interface(IInterface)
['{99D65C4A-C90C-40EF-9B6E-C360FAABE8B8}']
{ User Name }
function GetUserName: string;
procedure SetUserName(Value: string);
property UserName: string
read GetUserName write SetUserName;
{ Unique ID }
function GetUserID: variant;
procedure SetUserID(Value: variant);
property UserID: variant
read GetUserID write SetUserID;
{ Password }
function GetPassword: string;
procedure SetPassword(Value: string);
property Password: string
read GetPassword write SetPassword;
{ Rights }
function GetRights: string;
procedure SetRights(Value: string);
property Rights: string
read GetRights write SetRights;
function CheckRights(ARights: string): boolean;
end;
This interface is used to enforce what a user must be for the
TDBWebUser component to understand it.
Now that we have our interface, let's go
over the implementation.
TDBWebUser is our implementation of the IudWebUser interface. This class simply stores a
user's password, rights, and
username/user id by implementing the Get and Set functions defined in the
interface and storing the values in private variables. For example, here are the
GetPassword and SetPassword methods:
function TDBWebUser.GetPassword: string;
begin
Result := FPassword;
end;
procedure TDBWebUser.SetPassword(Value: string);
begin
FPassword := Value;
end;
Pretty simple, eh? To make assigning all these values easy, we add a few extra parameters
to the constructor and assign each field upon creation. Here is the constructor
source:
constructor TDBWebUser.Create(AUserName, APassword, ARights: string;
AUniqueID: variant);
begin
inherited Create;
FUserName := Trim(AUserName); // Because databases often add extra spaces to
FPassword := Trim(APassword); // fields that don't occupy all the room their
FRights := Trim(ARights); // given, we should "Trim()" the spaces off the
FUniqueID := Trim(AUniqueID); // values from the database.
end;
I called this class "TDBWebUser" and not
"TudWebUser" because this implementation is specifically
designed to work with a database, and not a generic "WebUser."
The next step is to implement the CheckRights function, which is the last
part of our implementation that is required by the IudWebUser interface.
CheckRights simply tells us whether the user has the given rights or not:
function TDBWebUser.CheckRights(ARights: string): boolean;
var
S: TStrings;
I: Integer;
begin
Result := True;
S := RightsAsStrings(ARights); // Breaks rights up into a list
try
if S.Count = 0 then Exit; // Checking blank rights, let them pass
for I := 0 to S.Count - 1 do
if AccessRights.IndexOf(S[I]) >= 0 then
Exit; // The result is already true, so we can just exit
Result := False; // If we make it this far, the rights were not found
finally S.Free; end;
end;
This routine simply iterates the rights the user has and, if it finds a
match, returns true. To do that, it uses the RightsAsStrings function to separate
the right in question out into a list, and the AccessRights read-only property
to access the users established rights. Below are the RightsAsStrings and
GetAccessRights functions:
function RightsAsStrings(const S: string): TStrings;
begin
Result := TStringList.Create;
try
ExtractStrings([',', ';', ' '], [], PChar(S), Result);
except
Result.Free;
raise;
end;
end;
function TDBWebUser.GetAccessRights: TStrings;
begin
if FAccessRights = nil then // only allocate memory when
FAccessRights := RightsAsStrings(FRights); // absolutely necessary
Result := FAccessRights;
end;
Both of these functions and the CheckRights function were copied from the original
Borland code.
Finally, let's look at the destructor. Since we don't necessarily allocate
the FAccessRights object, we have to make sure it is assigned before freeing it:
destructor TDBWebUser.Destroy;
begin
if Assigned(FAccessRights) then
FAccessRights.Free;
inherited Destroy;
end;
That's all there is to it! You can now register the component, drop it on
your Web App Page Module and begin using it. Enjoy!
