A database-enabled Web user list

By: Jimmy Tharpe

Abstract: Let's face it -- for most of us, user validation data needs to be stored in a database. Fortunately, writing a component to encapsulate this functionality is easy. By Jimmy Tharpe.

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:

  1. We have to know when the DataSet is freed, to avoid access violations.
  2. 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!


Server Response from: ETNASC04