我正在尝试向闪亮的应用添加登录信息，以便只有拥有正确用户名（测试）和密码（测试）的用户才能查看该应用。我经常是R用户，但对Shiny（和HTML）的使用经验非常有限，我需要编辑别人的闪亮应用来添加此登录功能。
我试图使用这个例子 Starting Shiny app after password input
应用程序我试图添加登录以使用dashboardPage并且相当复杂，但我只是想知道如何使用这个基本的仪表板模板这样的基本示例。 https://www.rdocumentation.org/packages/shinydashboard/versions/0.6.1/topics/dashboardPage
我尝试以下列方式编辑其他堆栈溢出答案中的代码，但它不起作用。
rm(list = ls())
library(shiny)
reports = data.frame(list.files("",full.names=FALSE))
colnames(reports) = c("Reports")
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left:
50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){ source("ui.R", local = T) }
ui = (htmlOutput("page"))
##############---------------------------------------------------------------------################
##############---------------------------------------------------------------------################
####Server function
server = (function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
observe({
if (USER$Logged == FALSE) {
if (!is.null(input$Login)) {
if (input$Login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
Id.username <- which(my_username == Username)
Id.password <- which(my_password == Password)
if (length(Id.username) > 0 & length(Id.password) > 0) {
if (Id.username == Id.password) {
USER$Logged <- TRUE
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2()) ) )
})
print(ui)
}
})
})
runApp(list(ui = ui, server = server))
其中ui.R是本地的，只是
library(shiny)
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(),
title = "Dashboard example"
)
但是我收到了错误
Warning in file(filename, "r", encoding = encoding) :
cannot open file 'ui.R': No such file or directory
我只想弄清楚如何编辑登录模板的服务器/ ui部分，以便我可以将其应用于使用dashboardPage的应用程序。我能够使用一个简单的直方图闪亮的应用程序，但没有其他任何东西。
答案 0 :(得分：0)
我以前也遇到过同样的问题，并且我也尝试过使您的解决方案有效，但是发现它太复杂了。我使用附加/删除选项卡和shinyjs构建了一个更简单的解决方法。它是这样工作的。
我在下面提供一个简单的示例。我还添加了一些不必要的功能，例如，用户历史记录对登录尝试的次数进行计数，用户日志和消息处理程序等。为了使操作简单起见，我将这些功能注释掉了，但是如果您有兴趣，可以看看。请注意，附加功能必须在服务器上运行。
登录所需的用户名和密码如下：
username password
user123 loginpassword1
user456 loginpassword2
library("shiny")
library("shinyjs")
library("stringr")
# in case you want to send error messages when login is wrong
# add this to the /www folder in your shiny app (shiny server) as message-handler.js file
#
# // This recieves messages of type "testmessage" from the server.
# Shiny.addCustomMessageHandler("testmessage",
# function(message) {
# alert(JSON.stringify(message));
# }
# );
shinyApp(
ui = fluidPage(
useShinyjs(), # Set up shinyjs
# Layout mit Sidebar
sidebarLayout(
## Sidebar -----
shinyjs::hidden(
div(id = "Sidebar", sidebarPanel(
# sidebarPanel(
# > some example input on sidebar -----
conditionalPanel(
condition = "input.tabselected > 1",
dateRangeInput(inputId = "date",
label = "Choose date range",
start = "2018-06-25", end = "2019-01-01",
min = "2018-06-25", max = "2019-01-01",
startview = "year"))
))), # closes Sidebar-Panel
# Main-Panel ------
mainPanel(
tabsetPanel(
# > Login -------
tabPanel("Login",
value = 1,
br(),
textInput("username", "Username"),
passwordInput("password", label = "Passwort"),
# If you want to add custom javascript messages
# tags$head(tags$script(src = "message-handler.js")),
actionButton("login", "Login"),
textOutput("pwd")
), # closes tabPanel
id = "tabselected", type = "pills"
) # closes tabsetPanel
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
# Server ------
server = function(input, output, session){
user_vec <- c("user123" = "loginpassword1",
"user456" = "loginpassword2")
# I usually do run the code below on a real app on a server
# user <- reactiveValues(his = readRDS(file = "logs/user_his.rds"),
# log = readRDS(file = "logs/user_log.rds"),
# vec = readRDS(file = "logs/user_vec.rds"))
#
# where user_his is defined as follows
# user_his <- vector(mode = "integer", length = length(user_vec))
# names(user_his) <- names(user_vec)
observeEvent(input$login, {
if (str_to_lower(input$username) %in% names(user_vec)) { # is username in user_vec?
# Alternatively if you want to limit login attempts to "3" using the user_his file
# if (str_to_lower(input$username) %in% names(user$vec[user$his < 3])) {
if (input$password == unname(user_vec[str_to_lower(input$username)])) {
# nulls the user_his login tries and saves this on server
# user$his[str_to_lower(input$username)] <- 0
# saveRDS(user$his, file = "logs/user_his.rds")
# Saves a temp log file
# user_log_temp <- data.frame(username = str_to_lower(input$username),
# timestamp = Sys.time())
# saves temp log in reactive value
# user$log <- rbind(user$log, user_log_temp)
# saves reactive value on server
# saveRDS(user$log, file = "logs/user_log.rds")
# > Add MainPanel and Sidebar----------
shinyjs::show(id = "Sidebar")
appendTab(inputId = "tabselected",
tabPanel("Tab 1",
value = 2
) # closes tabPanel,
)
appendTab(inputId = "tabselected",
tabPanel("Tab 2",
value = 3
) # closes tabPanel,
)
appendTab(inputId = "tabselected",
tabPanel("Tab 3",
value = 4
) # closes tabPanel
)
removeTab(inputId = "tabselected",
target = "1")
} else { # username correct, password wrong
# adds a login try to user_his
# user$his[str_to_lower(input$username)] <- user$his[str_to_lower(input$username)] + 1
# saves user_his on server
# saveRDS(user$his, file = "logs/user_his.rds")
# Messge which shows how many log-in tries are left
#
# session$sendCustomMessage(type = 'testmessage',
# message = paste0('Password not correct. ',
# 'Remaining log-in tries: ',
# 3 - user$his[str_to_lower(input$username)]
# )
# )
} # closes if-clause
} else { # username name wrong or more than 3 log-in failures
# Send error messages with javascript message handler
#
# session$sendCustomMessage(type = 'testmessage',
# message = paste0('Wrong user name or user blocked.')
# )
} # closes second if-clause
}) # closes observeEvent
} # Closes server
) # Closes ShinyApp