%
Function SendCDOSYS(sFrom, sTo, sSubject, sBody)
Dim objCDO, res
res = 0
On Error Resume Next
' create a CDO object
Set objCDO = Server.CreateObject("CDO.Message")
If Err.Number <> 0 Then
res = 1
Err.Clear
End If
On Error GoTo 0
If res = 0 Then
' set the properties
objCDO.From = sFrom
objCDO.To = sTo
objCDO.Subject = sSubject
objCDO.TextBody = sBody
On Error Resume Next
' send the email
objCDO.Send()
If Err.Number <> 0 Then
res = 2
Err.Clear
End If
On Error GoTo 0
End If
Set objCDO = Nothing
SendCDOSYS = res
End Function
Function SendCDONTS(sFrom, sTo, sSubject, sBody)
Dim objCDO, res
res = 0
On Error Resume Next
' create a CDO object
Set objCDO = Server.CreateObject("CDONTS.NewMail")
If Err.Number <> 0 Then
res = 1
Err.Clear
End If
On Error GoTo 0
If res = 0 Then
' set the properties
objCDO.From = sFrom
objCDO.To = sTo
objCDO.Subject = sSubject
objCDO.Body = sBody
On Error Resume Next
' send the email
objCDO.Send()
If Err.Number <> 0 Then
res = 2
Err.Clear
End If
On Error GoTo 0
End If
Set objCDO = Nothing
SendCDONTS = res
End Function
Function testMailServer(sMail, sSubject, sBody)
Dim ret, tmp
'first, try CDOSYS
ret = SendCDOSYS(sMail, sMail, sSubject, sBody)
If ret = 1 Then
'if non CDOSYS, try CDONTS
ret = SendCDONTS(sMail, sMail, sSubject, sBody)
If ret = 0 Then
tmp = "mail_cdonts-inc.asp"
Else
tmp = "mail_none-inc.asp"
response.write LANG_NO_MAIL_SYSTEM
End If
Else
tmp = "mail_cdosys-inc.asp"
If ret = 2 Then
response.write LANG_SMTP_FAILED
End If
End If
testMailServer = tmp
End Function
Function DBConnexion(sPath, sDBName, sMode, sUser, sPassword)
Dim oCn, sConnString, oFs, sDBPath
sDBPath = Server.MapPath(sPath)
Set oCn = Server.CreateObject("ADODB.Connection")
sConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & "DBQ=" & sDBPath & "/" & sDBName
Select Case sMode
Case "MSACC"
sConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & "DBQ=" & sDBPath & "/" & sDBName
Case "MYSQL"
sConnString = "driver=MySQL ODBC 3.51 Driver;server=" & sPath & ";uid=" & sUser & ";pwd=" & sPassword & ";database=" & sDBName
Case Else
sConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; " & "DBQ=" & sDBPath & "/" & sDBName
End Select
On Error Resume Next
oCn.Open sConnString
If Err.number <> 0 Then
Response.Write LANG_ERROR_DB_PATH
Response.End
Err.Clear
End If
On Error GoTo 0
Set DBConnexion = oCn
End Function
Function DateTimeToString(dDateTime)
DateTimeToString = Year(dDateTime) & Right("0" & Month(dDateTime), 2) & Right("0" & Day(dDateTime), 2) & " " & Right("0" & Hour(dDateTime), 2) & ":" & Right("0" & Minute(dDateTime), 2) & ":" & Right("0" & Second(dDateTime), 2)
End Function
Sub CreateTopTable(sTabName, sHeader)
Response.Write "
" & vbCRLF
If sHeader <> "" Then
Response.Write "
" & vbCRLF
Response.Write "
" & sHeader & "
" & vbCRLF
Response.Write "
" & vbCRLF
End If
Response.Write "
" & vbCRLF
Response.Write "
" & vbCRLF
End Sub
Sub CreateBottomTable (sFooter)
Response.Write "
" & vbCRLF
Response.Write "
" & vbCRLF
If sFooter <> "" Then
Response.Write "
" & vbCRLF
Response.Write "
" & sFooter & "
" & vbCRLF
Response.Write "
" & vbCRLF
End If
Response.Write "
" & vbCRLF
Response.Write " " & vbCRLF
End Sub
Dim sDBMainName
Dim sDBForumName
Dim sDBEventiName
Dim sDBGuestbookName
Dim sDir
Dim sThemeDir
Dim sImagesDir
Dim sImgNewsDir
Dim sSmileysDir
Dim sRssDir
Dim sDBDir
Dim sXMLDir
Dim sDynblockDir
Dim sAvatarsDir
Dim sAdminUploadFolder
Dim sUserUploadFolder
Dim sDBLogin
Dim sDBPassword
Dim sDBType
Dim oFs, oFile, sDirectory, X, bFileSO, bAlreadyConf
Dim sMsg, oCn, oCn2, oRs, oRs2, rSQL, sBlockMsg, sMailMsg
Dim sAdminPseudo, sAdminPwd
sDirectory = Replace(LCase(Request.ServerVariables("PATH_INFO")), "/" & sFileName, "")
bAlreadyConf = False
bFileSO = True
Response.Write "" & vbCRLF
Response.Write "" & vbCRLF
Response.Write "" & LANG_TITLE_PAGE & "" & vbCRLF
Response.Write "" & vbCRLF
Response.Write "" & vbCRLF
Response.Write "" & vbCRLF
Response.Write "" & vbCRLF
On Error Resume Next
Set oFs = Server.CreateObject("Scripting.FileSystemObject")
If Err.number <> 0 Then
Err.Clear
bFileSO = False
End If
On Error GoTo 0
If Not bFileSO Then
'impossible use of fso
Response.Write LANG_FILESYSTEM_FORBIDDEN & vbCRLF
Else
If oFs.FileExists(Server.MapPath("includes/configuration-inc.asp")) Then
'already configured
Response.Write LANG_SITE_ALREADY_CONFIGURED
Else
If Request.Form("sDBDir") <> "" Then
sDBType = "" & Request.Form("sDBType")
sDBDir = Request.Form("sDBDir")
If right(sDBDir,1) <> "/" And sDBType = "MSACC" Then
sDBDir = sDBDir & "/"
End If
sDBMainName = "" & Request.Form("sDBMainName")
sDBForumName = "" & Request.Form("sDBForumName")
sDBEventiName = "" & Request.Form("sDBEventiName")
sDBGuestbookName = "" & Request.Form("sDBGuestbookName")
If sDBMainName = "" Then
sDBMainName = "main.mdb"
End If
If sDBForumName = "" Then
sDBForumName = "forum.mdb"
End If
If sDBEventiName = "" Then
sDBEventiName = "calendar.mdb"
End If
If sDBGuestbookName = "" Then
SDBGuestbookName = "guestbook.mdb"
End If
If sDBType = "MSACC" Then
On Error Resume Next
oFs.createfolder Server.MapPath(sDBDir)
oFs.CopyFile Server.MapPath("db/main.mdb"), Server.MapPath(sDBDir & sDBMainName), True
oFs.CopyFile Server.MapPath("db/forum.mdb"), Server.MapPath(sDBDir & sDBForumName), True
oFs.CopyFile Server.MapPath("db/calendar.mdb"), Server.MapPath(sDBDir & sDBEventiName), True
oFs.CopyFile Server.MapPath("db/guestbook.mdb"), Server.MapPath(sDBDir & sDBGuestbookName), True
On Error GoTo 0
End If
'copy db in db path
If Not oFs.FileExists(Server.MapPath(sDBDir & sDBMainName)) And sDBType = "MSACC" Then
'impossible to create database in their dir
Response.Write LANG_DATABASE_FORBIDDEN & vbCRLF & " " & sDBDir
Else
sXMLDir = Request.Form("sXMLDir")
If right(sXMLDir,1) <> "/" Then
sXMLDir = sXMLDir & "/"
End If
On Error Resume Next
oFs.createfolder Server.MapPath(sXMLDir)
oFs.CopyFile Server.MapPath("lang/IT.xml"), Server.MapPath(sXMLDir & "IT.xml"), True
oFs.CopyFile Server.MapPath("lang/EN.xml"), Server.MapPath(sXMLDir & "EN.xml"), True
oFs.CopyFile Server.MapPath("lang/configuration.xml"), Server.MapPath(sXMLDir & "configuration.xml"), True
oFs.CopyFile Server.MapPath("lang/menuitems.xml"), Server.MapPath(sXMLDir & "menuitems.xml"), True
oFs.CopyFile Server.MapPath("lang/controlpanel.xml"), Server.MapPath(sXMLDir & "controlpanel.xml"), True
oFs.CopyFile Server.MapPath("lang/toolbar.xml"), Server.MapPath(sXMLDir & "toolbar.xml"), True
On Error GoTo 0
'copy xml in lang path
If Not oFs.FileExists(Server.MapPath(sXMLDir & "configuration.xml")) Then
'impossible to write xml in their dir
Response.Write LANG_XML_FORBIDDEN & vbCRLF & " " & sXMLDir
Else
sDynBlockDir = Request.Form("sDynBlockDir")
If right(sDynBlockDir,1) <> "/" Then
sDynBlockDir = sDynBlockDir & "/"
End If
On Error Resume Next
oFs.createfolder Server.MapPath(sDynBlockDir)
oFs.CopyFile Server.MapPath("public/dynblock/dyna_block.asp"), Server.MapPath(sDynBlockDir & "dyna_block.asp"), True
On Error GoTo 0
'copy dynblock in dynblock path
If Not oFs.FileExists(Server.MapPath(sDynBlockDir & "dyna_block.asp")) Then
'impossible to write block in their dir
Response.Write LANG_DYNBLOCK_FORBIDDEN & vbCRLF & " " & sDynBlockDir
Else
'write data in db
sAdminPseudo = Request.Form("uLogin")
sAdminPwd = Request.Form("uPassword")
sDBLogin = Request.Form("sDBLogin")
sDBPassword = "" & Request.Form("sDBPassword")
'open db
Set oCn = DBConnexion(sDBDir, sDBMainName, sDBType, sDBLogin, sDBPassword)
rSQL = "SELECT uLogin FROM users WHERE uLogin='" & Replace(sAdminPseudo, "'", "''") & "'"
Set oRs = oCn.Execute(rSQL)
If oRs.EOF Then
rSQL = "INSERT INTO users (uLogin, uPassword, uEmail, uMSN, uYahoo, uICQ, uAIM, uURL, uSignature, uRole, uDate, uNewsletter, uProfile, uValid) VALUES ('" & Replace(sAdminPseudo, "'", "''") & "', '" & Replace(sAdminPwd, "'", "''") & "', '" & Replace(Request.Form("SiteEmail"), "'", "''") & "', '', '', '', '', '" & Replace(Request.Form("SiteURL"), "'", "''") & "', '', 3, '" & DateTimeToString(Now()) & "', 0, 0, 1)"
oCn.Execute rSQL
rSQL = "SELECT vCode FROM versions WHERE vCode='" & Replace(sLangCode, "'", "''") & "'"
Set oRs2 = oCn.Execute(rSQL)
If oRs2.EOF Then
rSQL = "INSERT INTO versions (vCode, vTitle, vPicture) VALUES ('" & Replace(sLangCode, "'", "''") & "', '" & Replace(LANG_VERSION_NAME, "'", "''") & "', '')"
oCn.Execute rSQL
End If
oRs2.close
Set oRs2 = Nothing
Set oCn2 = DBConnexion(sDBDir, sDBForumName, sDBType, sDBLogin, sDBPassword)
rSQL = "INSERT INTO owners (OwnerID) VALUES ('" & Replace(sAdminPseudo, "'", "''") & "')"
oCn2.Execute rSQL
oCn2.Close
Set oCn2 = Nothing
End If
oRs.close
Set oRs = Nothing
oCn.Close
Set oCn = Nothing
'if I use ACCESS, I set the password
If sDBPassword <> "" And sDBType = "MSACC" Then
Set oCn = DBConnexion(sDBDir, sDBMainName, sDBType, sDBLogin, sDBPassword)
rSQL = "ALTER DATABASE PASSWORD " & sDBPassword & " NULL"
oCn.Execute rSQL
oCn.Close
Set oCn = Nothing
Set oCn = DBConnexion(sDBDir, sDBForumName, sDBType, sDBLogin, sDBPassword)
rSQL = "ALTER DATABASE PASSWORD " & sDBPassword & " NULL"
oCn.Execute rSQL
oCn.Close
Set oCn = Nothing
Set oCn = DBConnexion(sDBDir, sDBEventiName, sDBType, sDBLogin, sDBPassword)
rSQL = "ALTER DATABASE PASSWORD " & sDBPassword & " NULL"
oCn.Execute rSQL
oCn.Close
Set oCn = Nothing
End If
'write data in includes
sMsg = "<" & "%" & vbCRLF
sMsg = sMsg & " ' General website's information" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_DEFAULT_VERSION = ""IT""" & vbCRLF
sMsg = sMsg & " ' Website's name" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_NAME = """ & Request.Form("SiteName") & """" & vbCRLF
sMsg = sMsg & " ' Website's base url" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_URL = """ & Request.Form("SiteURL") & """" & vbCRLF
sMsg = sMsg & "" & vbCRLF
sMsg = sMsg & " 'Database constants" & vbCRLF
sMsg = sMsg & " Const DB_MAIN = """ & sDBMainName & """" & vbCRLF
sMsg = sMsg & " Const DB_FORUM = """ & sDBForumName & """" & vbCRLF
sMsg = sMsg & " Const DB_CALENDAR = """ & sDBEventiName & """" & vbCRLF
sMsg = sMsg & " Const DB_GUESTBOOK = """ & sDBGuestbookName & """" & vbCRLF
sMsg = sMsg & "" & vbCRLF
sMsg = sMsg & " Const GLOBAL_DB_TYPE = """ & sDBType & """" & vbCRLF
sMsg = sMsg & " Const GLOBAL_DB_LOGIN = """ & sDBLogin & """" & vbCRLF
sMsg = sMsg & " Const GLOBAL_DB_PASSWORD = """ & sDBPassword & """" & vbCRLF
sMsg = sMsg & "" & vbCRLF
sMsg = sMsg & " ' Paths. Edit ALL paths IF YOU ARE IN A VIRTUAL DIRECTORY !" & vbCRLF
sMsg = sMsg & " ' put a ""/myAspNukeDir"" before paths if you're in a virtual directory, " & vbCRLF
sMsg = sMsg & " ' where /myAspNukeDir is your virtual directory. " & vbCRLF
sMsg = sMsg & " ' For example : Const GLOBAL_SITE_PATH = ""/mywebsite/""" & vbCRLF
sMsg = sMsg & "" & vbCRLF
sMsg = sMsg & " ' Website path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_PATH = """ & Request.Form("sDir") & """" & vbCRLF
sMsg = sMsg & " ' admin path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_ADMIN_PATH = """ & Request.Form("sDir") & "admin_""" & vbCRLF
sMsg = sMsg & " ' forum path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_FORUM_PATH = """ & Request.Form("sDir") & "forum_""" & vbCRLF
sMsg = sMsg & " ' Themes Path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_THEMES_PATH = """ & Request.Form("sThemeDir") & """" & vbCRLF
sMsg = sMsg & " ' Pictures directory" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_IMAGES_PATH = """ & Request.Form("sImagesDir") & """" & vbCRLF
sMsg = sMsg & " ' News pictures directory" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_IMAGES_NEWS_PATH = """ & Request.Form("sImgNewsDir") & """" & vbCRLF
sMsg = sMsg & " ' Smileys pictures directory" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_IMAGES_SMILEYS_PATH = """ & Request.Form("sSmileysDir") & """" & vbCRLF
sMsg = sMsg & " ' Backend path and file" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_BACKEND_PATH = """ & Request.Form("sRssDir") & """" & vbCRLF
sMsg = sMsg & " ' Database path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_DATABASE_PATH = """ & Request.Form("sDBDir") & """" & vbCRLF
sMsg = sMsg & " ' Language files path" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_VERSIONS_PATH = """ & Request.Form("sXMLDir") & """" & vbCRLF
sMsg = sMsg & " 'path of dynamic blocks includes" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_DYNBLOCK_PATH = """ & Request.Form("sDynblockDir") & """" & vbCRLF
sMsg = sMsg & " 'path of avatars" & vbCRLF
sMsg = sMsg & " Const GLOBAL_SITE_AVATARS_PATH = """ & Request.Form("sAvatarsDir") & """" & vbCRLF
sMsg = sMsg & "" & vbCRLF
sMsg = sMsg & " 'UPLOAD CONFIGURATION" & vbCRLF
sMsg = sMsg & " 'path where the files are saved" & vbCRLF
sMsg = sMsg & " ' - you have to use a path in which you have write permissions" & vbCRLF
sMsg = sMsg & " Const sAdminUploadFolder = """ & Request.Form("sAdminUploadFolder") & """" & vbCRLF
sMsg = sMsg & " Const sUserUploadFolder = """ & Request.Form("sUserUploadFolder") & """" & vbCRLF
sMsg = sMsg & "%" & ">" & vbCRLF
'first the block-inc.asp, then the mail-inc.asp and finally the configuration-inc.asp
On Error Resume Next
Set oFile = oFs.OpenTextFile(Server.MapPath("includes/blocks-inc.asp"), 2, True)
sBlockMsg = ""
oFile.Write sBlockMsg
oFile.Close
Set oFile = Nothing
On Error GoTo 0
On Error Resume Next
Set oFile = oFs.OpenTextFile(Server.MapPath("includes/mail-inc.asp"), 2, True)
sMailMsg = ""
oFile.Write sMailMsg
oFile.Close
Set oFile = Nothing
On Error GoTo 0
On Error Resume Next
Set oFile = oFs.OpenTextFile(Server.MapPath("includes/configuration-inc.asp"), 2, True)
oFile.Write sMsg
oFile.Close
Set oFile = Nothing
On Error GoTo 0
If oFs.FileExists(Server.MapPath("includes/configuration-inc.asp")) Then
Response.Write LANG_CONFIGURATION_CREATED1 & vbCRLF
Response.Write LANG_CONFIGURATION_CREATED2 & vbCRLF
Else
Response.Write LANG_FILESYSTEM_FORBIDDEN1 & vbCRLF
'if I cannot write in includes, I show the text in 2 textarea
Response.Write "" & vbCRLF
End If
Response.Write LANG_CONFIGURATION_END1 & vbCRLF
Response.Write LANG_CONFIGURATION_END2 & vbCRLF
Response.Write LANG_CONFIGURATION_END3 & vbCRLF
End If
End If
End If
Else
CreateTopTable "setup", "ASP-Nuke Setup (" & sVersion & ") - " & LANG_VERSION_NAME
Response.Write LANG_INTRODUCTION1 & vbCRLF
Response.Write LANG_INTRODUCTION2 & vbCRLF
Response.Write LANG_INTRODUCTION3 & vbCRLF
Response.Write "" & vbCRLF
Response.Write "