【delphi开源代码栏目提醒】:网学会员--在 delphi开源代码编辑为广大网友搜集整理了:AddUserPageMod.pas绩等信息，祝愿广大网友取得需要的信息，参考学习。

    
    unit AddUserPageMod;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd,
      CompProd, PagItems, SiteProd, MidItems, WebForm, WebAdapt, WebComp;
    
    type
      TAddUserPageModule = class(TWebPageModule)
        Adapter: TAdapter;
        AddUser: TAdapterAction;
        Name: TAdapterField;
        Password: TAdapterField;
        PasswordVerify: TAdapterField;
        Messages: TAdapterField;
        UpdateUser: TAdapterAction;
        DeleteUser: TAdapterAction;
        trvlsAccessRights: TStringsValuesList;
        AccessRights: TAdapterField;
        UserListAdapter: TAdapter;
        UserName: TAdapterField;
        UserRights: TAdapterField;
        PageProducer1: TPageProducer;
        procedure AddUserExecute(Sender: TObject; Params: TStrings);
        procedure WebPageModuleCreate(Sender: TObject);
        procedure NameGetValue(Sender: TObject; var Value: Variant);
        procedure MessagesGetValue(Sender: TObject; var Value: Variant);
        procedure WebPageModuleActivate(Sender: TObject);
        procedure UpdateUserExecute(Sender: TObject; Params: TStrings);
        procedure DeleteUserExecute(Sender: TObject; Params: TStrings);
        procedure UserNameGetValue(Sender: TObject; var Value: Variant);
        procedure UserRightsGetValue(Sender: TObject; var Value: Variant);
        procedure UserListAdapterIterateRecords(Sender: TObject;
          Action: TIteratorMethod; var EOF: Boolean);
    
      private
        FLastUserName: string;
        FMessageValue: string;
    
        FCurrentIndex: Integer;
      public
        { Public declarations }
      end;
    
      function AddUserPageModule: TAddUserPageModule;
    
    implementation
    
    {$R *.dfm}  {*.html}
    
    uses WebReq, WebCntxt, AdaptReq, WebFact, Variants, MainPageMod, SiteComp, WebUsers;
    
    resourcestring
      rBlankName = 'The name is blank.';
      rPassBlank = 'The password is blank.';
      rPassDontMatch = 'The passwords do not match.';
      rUserExists = 'The user %s already exists. Please choose another name.';
      rUserSuccessAdded = 'User %s successfully added.';
      rRootWarning = 'Warning: you are using the root account with the default password!';
      rUnknownUser = 'Unknown user to set password for.';
      rBlankNewPass = 'New password is blank.';
      rCantFindUser = 'The user %s can not be found to be set the password!';
      rUserUpdated = 'User %s successfully updated.';
      rCantFindUserToDelete = 'The user %s can not be found to be deleted!';
      rUserDeleted = 'User %s successfully deleted.';
      rAddUserTitle = 'Add/Modify Users';
      rAddUserDescript = 'Add, delete and modify users.';
    
    
    function AddUserPageModule: TAddUserPageModule;
    begin
      Result := TAddUserPageModule(WebContext.FindModuleClass(TAddUserPageModule));
    end;
    
    procedure TAddUserPageModule.AddUserExecute(Sender: TObject;
      Params: TStrings);
    var
      Value: IActionFieldValue;
      StrName: string;
      StrPass: string;
      StrPassVerify: string;
      StrRights: string;
      DontAddUser: boolean;
      WebUser: TWebUserItem;
    begin
      DontAddUser := False;
      try
        Value := Name.ActionValue;
        if Assigned(Value) then
          StrName := Value.Values[0];
        Value := Password.ActionValue;
        if Assigned(Value) then
          StrPass := Value.Values[0];
        Value := PasswordVerify.ActionValue;
        if Assigned(Value) then
          StrPassVerify := Value.Values[0];
        Value := AccessRights.ActionValue;
        if Assigned(Value) then
          StrRights := Value.Values[0]
        else
          StrRights := '';
    
        // Make sure the name isn't empty
        if Trim(StrName) = '' then
        begin
    
          Adapter.Errors.AddError(Exception.Create(rBlankName));
          DontAddUser := True;
        end;
        if StrPass = '' then
        begin
          Adapter.Errors.AddError(Exception.Create(rPassBlank));
          DontAddUser := True;
        end;
        if StrPass <> StrPassVerify then
        begin
          Adapter.Errors.AddError(Exception.Create(rPassDontMatch));
          DontAddUser := True;
        end;
    
        // Exit if an error happened above, after filling in what the
        // user already put in.
        if DontAddUser then
        begin
          FLastUserName := StrName; // Filled in with the NameGetValue event
          // Don't fill in the password for security reasons
          Exit;
        end;
    
        // Check to see if that user already exists
        WebUser := MainPageModule.PersistWebUserList.UserItems.FindUserName(StrName);
        if WebUser <> nil then
        begin
          Adapter.Errors.AddError(Exception.CreateFmt(rUserExists, [StrName]));
        end else
        begin
          // Add the user to the main page's user list
          WebUser := MainPageModule.PersistWebUserList.UserItems.Add as TWebUserItem;
          WebUser.UserName := StrName;
          WebUser.Password := StrPass;
          WebUser.AccessRights := StrRights;
          MainPageModule.SaveUserList;
          FMessageValue := Format(rUserSuccessAdded, [StrName]);
        end;
      except
        on E: Exception do
          Adapter.Errors.AddError(E);
      end;
    end;
    
    procedure TAddUserPageModule.WebPageModuleCreate(Sender: TObject);
    begin
      FLastUserName := '';
      FMessageValue := '';
    end;
    
    procedure TAddUserPageModule.NameGetValue(Sender: TObject;
      var Value: Variant);
    begin
      Value := FLastUserName;
    end;
    
    procedure TAddUserPageModule.MessagesGetValue(Sender: TObject;
      var Value: Variant);
    begin
      Value := FMessageValue;
    end;
    
    procedure TAddUserPageModule.WebPageModuleActivate(Sender: TObject);
    var
      WebUserItem: TWebUserItem;
    begin
      // Show a warning if they are running as "root" with the default password (root)
      with MainPageModule do
      begin
        if not VarIsEmpty(EndUserSessionAdapter.UserID) then
        begin
          WebUserItem := PersistWebUserList.UserItems.FindUserID(EndUserSessionAdapter.UserId);
          if WebUserItem <> nil then
            if (WebUserItem.UserName = 'root') and (WebUserItem.Password = 'root') then { do not localize }
              FMessageValue := rRootWarning;
        end;
      end;
    end;
    
    procedure TAddUserPageModule.UpdateUserExecute(Sender: TObject;
      Params: TStrings);
    var
      Value: IActionFieldValue;
      StrName: string;
      StrPassword: string;
      StrRights: string;
      WebUser: TWebUserItem;
    begin
      try
        Value := Name.ActionValue;
        if Assigned(Value) then
          StrName := Value.Values[0]
        else
          StrName := '';
          
        if StrName = '' then
          raise Exception.Create(rUnknownUser);
    
        Value := AccessRights.ActionValue;
        if Assigned(Value) then
          StrRights := Value.Values[0]
        else
          StrRights := '';
    
        Value := Password.ActionValue;
        if Assigned(Value) then
          StrPassword := Value.Values[0]
        else
          StrPassword := '';
                            
        WebUser := MainPageModule.PersistWebUserList.UserItems.FindUserName(StrName);
        if WebUser = nil then
          raise Exception.CreateFmt(rCantFindUser, [StrName]);
          
        if StrPassword <> '' then
          WebUser.Password := StrPassword;
        if StrRights <> '' then
          WebUser.AccessRights := StrRights;
          
        MainPageModule.SaveUserList;
        FMessageValue := Format(rUserUpdated, [StrName]);
      except
        on E: Exception do
          Adapter.Errors.AddError(E);
      end;
    end;
    
    procedure TAddUserPageModule.DeleteUserExecute(Sender: TObject;
      Params: TStrings);
    var
      Value: IActionFieldValue;
      StrName: string;
      WebUser: TWebUserItem;
    begin
      try
        StrName := '';
        Value := Name.ActionValue;
        if Assigned(Value) then
          StrName := Value.Values[0];
    
        WebUser := MainPageM

上一篇：AddUser.pas
下一篇：法律专业开题报告范文