%@ Language="VBSCRIPT"%>
<%
'-------------------
' Spooky Login 2000 ©
' www.Outfront.net
CONST admin_mainVersion = 3.07
'-------------------
ON ERROR RESUME NEXT
%>
<%Call CheckForReset()%>
<%
Dim errReadFail,errWriteFail,wImg,rImg,txtOpenDatabase,txtUpdateDatabase,errMessage
Dim DatabasePath,PageDisplay,dActualADOVersion,fieldvalue,bIsSQL,txtUpgrade
CONST dRequiredADOVersion = 2.1
CONST dRequiredVBScriptVersion = 5.0
DatabasePath = left(DatabaseFolder, inStrRev(DatabaseFolder,"\"))
PageDisplay = Request.Querystring("PageDisplay")
sPageName = Request.ServerVariables("URL")
errSystemFail = 0
If cf_error then errSystemFail = errSystemFail +1
%>
<%
Call CheckForLogout()
Call objCheckDatabase()
If Application(appName&"Setup_ID")&"" <> "" AND errSystemFail = 0 then
Call CheckForAdmin()
Elseif Application(appName&"Setup_ID")&"" = "" OR errSystemFail <> 0 then
'# Admin only if system has failed
Session(appName&"Admin")=true
End if
If errSystemFail > 0 OR Application(appName&"Setup_Id")&"" ="" then PageDisplay="Diagnostics"
'====================
Sub objCheckDatabase
'====================
ON ERROR RESUME NEXT
Err = 0
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Open sDSN
dActualADOVersion = objConn.Version
If err > 0 then
errMessage = errMessage & err.description & "
"
err=0
End if
Call objTestRead()
If (strDbase = "SQL" OR strDbase="MYSQL") OR inStr(sDSN,"SQL") then
If NOT errReadFail then
wImg = "yes"
bIsSQL= -1
Else
wImg = "no"
bIsSQL= -1
End if
Else
Call objTestWrite()
End if
objConn.Close
Set objConn = Nothing
Err = 0
End sub
'===============
Sub objTestRead
'===============
ON ERROR RESUME NEXT
Err = 0
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.Open sTableName & "config", objConn, 1, 2
fieldvalue = objRS("setup_id")
If err.number <> 0 then
rImg = "no"
errReadFail = True
errSystemFail = errSystemFail + 1
errMessage = errMessage & err.description & "
"
Else
rImg = "yes"
End if
Call CloseRs()
Err = 0
End Sub
'================
Sub objTestWrite
'================
ON ERROR RESUME NEXT
Err = 0
objConn.Execute("Update "&sTableName &"config SET test_field='"&LoginVersion&"'")
If err.number <> 0 then
wImg = "no"
errWriteFail = True
errSystemFail = errSystemFail + 1
errMessage = errMessage & err.description & "
"
Else
If objConn.errors.count <> 0 then
wImg = "no"
errWriteFail = True
errSystemFail = errSystemFail + 1
Else
wImg = "yes"
End if
End if
Err = 0
End Sub
'================
Sub CheckForReset()
'================
If lCase(Request.Querystring("Reset")) = "true" then
Application.Lock
Application(appName&"Setup_ID") = ""
Application(appName&"Reset") = "True"
Application.UnLock
End if
End Sub
'================
Function GetDBSize()
'================
If NOT errReadFail AND IsObjInstalled(ScriptingObject) then
Dim strFileName,objFSO,objFile,iFileSize
strFileName = Server.Mappath(DatabaseFolder)
Set objFSO = Server.CreateObject(ScriptingObject)
Set objFile = objFSO.GetFile(strFileName)
GetDBSize = objFile.Size
Set objFSO = Nothing
Else
GetDBSize = 0
End if
End Function
'================
Sub GetTableNames()
'================
Dim RequiredTable(7)
Dim FoundTable(7)
Dim RequiredColumn(7)
Dim fNum
RequiredTable(0) = lcase(sTableName)&"active_users"
RequiredColumn(0)= 5
RequiredTable(1) = lcase(sTableName)&"config"
RequiredColumn(1)= 23
RequiredTable(2) = lcase(sTableName)&"login_custom_fields"
RequiredColumn(2)= 5
RequiredTable(3) = lcase(sTableName)&"login_system_app"
RequiredColumn(3)= 2
RequiredTable(4) = lcase(sTableName)&"users"
RequiredColumn(4)= 33
RequiredTable(5) = lcase(sTableName)&"login_option_list"
RequiredColumn(5)= 4
RequiredTable(6) = lcase(sTableName)&"login_user_files"
RequiredColumn(6)= 3
RequiredTable(7) = lcase(sTableName)&"login_file_desc"
RequiredColumn(7)= 3
Response.write ("")
ON ERROR RESUME NEXT
set adoxConn = CreateObject("ADOX.Catalog")
set adodbConn = CreateObject("ADODB.Connection")
adodbConn.open sDSN
adoxConn.activeConnection = adodbConn
If err then
adodbConn.close: set adodbConn = nothing
set adoxConn = nothing
else
for each table in adoxConn.tables
if table.type="TABLE" then
fNum = 0
for i = 0 to uBound(RequiredTable)
If lcase(table.name) = lcase(RequiredTable(i)) AND errWriteFail=false then
for each column in table.columns
fnum = fnum+1
next
if fNum < RequiredColumn(i) then
Response.write (" "&table.name & "
")
else
Response.write (" "&table.name & "
")
end if
FoundTable(i) = true
exit for
End if
next
end if
next
adodbConn.close
set adodbConn = nothing
set adoxConn = nothing
for i = 0 to uBound(RequiredTable)
If NOT FoundTable(i) then
Response.write (" "&RequiredTable(i)& "
")
end if
Next
End if
Response.write ("")
End sub
%>
|
|
Welcome to the Login Management Center
")
if NOT CheckSuperUser then
Response.write (" ! NOTE : Diagnostics are unavailable.
" %>
<%If errReadFail then %> ! ERROR - Database cannot be found <%If bIsSQL then %> Please check the SQL connection<%=errMessage%> <%else%> The probable cause, is that the database has been copied to the wrong
directory or does not yet exist. By default, FP2000 places your database in the \fpdb\ folder. Your database path from the connection file is currently : <%=DatabasePath%> <%End if%> <%End if If errWriteFail AND NOT errReadFail then%> ! ERROR - Database is read only The cause is that the file does not have the correct permissions to be able to write to the database. One method that I have found reliable, using FP2000, open your web live
(file > open web > your address) Click file > import and locate your local copy of that database
<%End if
If LoginVersion ="" OR db_connVersion = "" OR A_GeneralVersion = "" then%>
!
ERROR - Include files not set up
You must be logged in to access this area <%End If%> |
|||||||||||||||||||||||
| Diagnostics | |
| Database | |
|
Read Database |
Verify that the database is in the <%=DatabasePath%> folder <%=IFF(sTableName<>"", " and the table prefix is "&sTableName&"","")%> The path must be corrected in db_conn.asp, or the database moved.<%end if%> |
| Write Database |
Verify that the <%=DatabasePath%> folder has both read and write access <%Elseif bIsSQL then%> <%=strDbase%> Server <%If uCase(strDbase) <> "SQL" AND uCase(strDbase) <> "MYSQL" then%> Please open db_conn.asp and set the constant 'strDbase' value to 'SQL'<%End if%> <%End if%> |
| Database Tables | <%GetTableNames%> |
| Connection string | |
| <%=sDSN%> | |
| Database Folder | |
| Database Size | <%=GetDBSize%> bytes <%IF NOT errWriteFail AND NOT errReadFail then%>[compact] [backup] <%end if%> |
| Server Settings | |
| Server Software | <%= Request.ServerVariables("SERVER_SOFTWARE") %> |
| Server Name | <%= Request.ServerVariables("SERVER_NAME") %> |
| Server Protocol | <%= Request.ServerVariables("SERVER_PROTOCOL") %> |
| VBScript Engine | <%= ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion %> |
| Physical Path | <%= Request.ServerVariables("APPL_PHYSICAL_PATH") %> |
| ADO Version | <%=dActualADOVersion%> |
| FSO (Templates) |
|
| XMLHTTP (PayPal) |
|
| E-Mail components | |
| Detected : |
<%
Dim i
For i=0 to UBound(theComponent)
If IsObjInstalled(theComponent(i)) Then
Response.write (""& theComponentName(i) &" ") iCompInstalled = iCompInstalled + 1 End If Next If iCompInstalled < 1 then Response.write (" None") %> |
| Login Settings | |
| Application Variables |
|
| Application Name | <%=appName%> (ID=<%=Application(appName&"setup_id")%>) |
| Login Version | <%=LoginVersion%> |