<% Dim nof_rootDir, nof_sitePath, nof_scriptDir, nof_debug, nof_componentName, _ nof_componentId, nof_scriptInterfaceFile, nof_langFile, nof_locale nof_rootDir = Request.Form("nof_rootDir") nof_sitePath = Request.Form("nof_sitePath") nof_scriptDir = Request.Form("nof_scriptDir") nof_debug = Request.Form("nof_debug") nof_componentName = Request.Form("nof_componentName") nof_componentId = Request.Form("nof_componentId") nof_scriptInterfaceFile = Request.Form("nof_scriptInterfaceFile") nof_langFile = Request.Form("nof_langFile") Set nof_locale = ssLocaleToDictionary(nof_sitePath & nof_scriptDir, nof_langFile) Call ssGetPasswordMain() Sub ssGetPasswordMain() On Error Resume Next Dim suiteTags Set suiteTags = Server.CreateObject("scripting.dictionary") suiteTags.Add "dbpath", "dbPath" suiteTags.Add "uploaddir", "dbFileUploadDir" suiteTags.Add "sendemail", "sendEmail" suiteTags.Add "smtpip", "emailServer" suiteTags.Add "smtpport", "emailServerPort" suiteTags.Add "emailto", "emailToAddress" suiteTags.Add "emailfrom", "emailFromAddress" suiteTags.Add "debug", "publishInDebugMode" suiteTags.Add "dbcolumns", "dbColumns" suiteTags.Add "language", "language" Dim compGeneralTags Set compGeneralTags = Server.CreateObject("scripting.dictionary") compGeneralTags.Add "currentpage", "currentPage" compGeneralTags.Add "nextpage", "nextPage" compGeneralTags.Add "errormark", "errorMark" compGeneralTags.Add "accessdeniedpage", "accessDeniedPage" Err.Clear() Dim XMLDoc Set XMLDoc = ssOpenXMLFile(nof_sitePath & nof_scriptDir & "\" & nof_scriptInterfaceFile) If Err.number <> 0 Then ' The method above returns only documented exceptions, ' so we safely pass the error object further Call ssRaiseFatalError(Err, "div", nof_debug) exit sub End If Dim ComponentNode Set ComponentNode = ssGetNode(XMLDoc,,"Component", Array("name","id"), Array(nof_ComponentName, nof_componentId), -1) If ComponentNode Is Nothing Then Err.Raise 400, "ss_getPassword_post.main.20", ssGetLocaleString("Error.400", Null) Call ssRaiseFatalError(err, "div", nof_debug) exit sub End If dbPath = ssGetProperty(ComponentNode, suiteTags.Item("dbpath")) if dbPath = "" then Err.Raise 526, "ss_getPassword_post.main.40", ssGetLocaleString("Error.526", Null) Call ssRaiseFatalError(err, "div", nof_debug) exit sub end if dbFields = ssGetDBFields(ComponentNode, suiteTags.Item("dbcolumns")) if dbFields = "" then set signupNode = ssGetByDBpath(XMLDoc, "signup", suiteTags.Item("dbpath"), dbPath) dbFields = ssGetDBFields(signupNode, suiteTags.Item("dbcolumns")) set signupNode = nothing end if Dim absPath, relPath if not inStr(1, dbPath, "\", 1) > 0 then set relPath = Nothing set relPath = ssReFind(dbPath, "\.\./") absPath = Server.MapPath(".") if not relPath is nothing then if relPath.count > 0 then for i=1 to relPath.count absPath = Left(absPath, inStrRev(absPath,"\") - 1) dbPath = Replace(dbPath, "../", "", 1, 1) next else if inStr(1, dbPath, "./") > 0 then dbPath = Replace(dbPath, "./", "", 1, 1) end if end if set relPath = nothing end if dbPath = absPath & "\" & Replace(dbPath, "/", "\") end if allFields = split(request.form,"&") %>
" method="post" target='_self'> <% for i=0 to UBound(allFields) errFlag = false fieldName = split(allFields(i),"=")(0) fieldValue = Replace(request.form(fieldName), """", "", 1, -1, 1) call ssBuildHiddenField(fieldName, fieldValue) propValue = "" set errEvent = getErrorEvent(ComponentNode, fieldName, "required") if not errEvent is nothing then propValue = ssGetProperty(errEvent, "message") end if if not errFlag AND Len(propValue) > 0 then if not Len(fieldValue) > 0 then errFlag = true errLocal = errLocal & "" end if end if if not errFlag AND inStr(fieldName, "email") > 0 then if not CheckEmail(fieldValue) then errFlag = true propValue = "" set errEvent = getErrorEvent(ComponentNode, fieldName, "invalidemail") if not errEvent is nothing then propValue = ssGetProperty(errEvent, "message") end if errLocal = errLocal & "" end if end if if errFlag then call ssBuildHiddenField(nof_ComponentID & "_" & fieldName & "ErrImg", ssGetProperty(ComponentNode, compGeneralTags.Item("errormark"))) end if next if not Len(errLocal) > 0 then dim result, objMail if ssFileExists(dbPath) then 'check if the fields are the same tableHead = ssGetLine(dbPath) if LCase(dbFields) <> LCase(tableHead) then ssCreateDB dbPath, dbFields if (Err.Number <> 0) Then Call ssRaiseFatalError(err, null, nof_Debug) exit sub end if tableHead = ssGetLine(dbPath) end if else 'create the database ssCreateDB dbPath, dbFields if (Err.Number <> 0) Then Call ssRaiseFatalError(err, null, nof_Debug) exit sub end if tableHead = ssGetLine(dbPath) end if result = GetEmail(dbPath, request.form("email")) if (Err.Number <> 0) Then Call ssRaiseFatalError(err, null, nof_Debug) exit sub end if if Len(result) > 0 then Dim emailTemplate emailTemplate = nof_sitePath & nof_scriptDir & "\ss_GetPasswordTemplate_" & _ ssGetProperty(ComponentNode, suiteTags.Item("language")) & ".properties" if ssFileExists(emailTemplate) then Dim emailFileContent, fromEmail, subject, body, startIt, stopIt, newBody, iteration body = ssGetTemplateValue(emailTemplate, "Body") startIt = InStr(1, body, "{beginiterator}", 1) stopIt = InStr(1, body, "{enditerator}", 1) newBody = Replace(Left(body, startit-1), "\n", "
", 1, -1, 1) iteration = Replace(Mid(body, startIt + Len("{beginiterator}"), stopIt-(startIt+Len("{beginiterator}"))), "\n", "
", 1, -1, 1) Set regEx = New RegExp regEx.Pattern = "UserId=(.*)\sPassword=(.*)" regEx.IgnoreCase = True regEx.Global = true Set Matches = regEx.Execute(result) For Each Match in Matches newBody = newBody & Replace(Replace(iteration, "{0}", Match.SubMatches(0), 1, -1, 1), "{1}", Match.SubMatches(1), 1, -1, 1) Next newBody = newBody & Replace(Right(body, Len(body)-(stopIt + 1 + Len("{enditerator}"))), "\n", "
", 1, -1, 1) Set objMail = new ss_CDOMail objMail.SmtpServer = ssGetProperty(ComponentNode, suiteTags.Item("smtpip")) objMail.SmtpBackupServer = "localhost" objMail.EmailTo = Session("fpEmail") objMail.EmailFrom = ssGetProperty(ComponentNode, suiteTags.Item("emailfrom")) objMail.EmailSubject = ssGetTemplateValue(emailTemplate, "Subject") objMail.AddHtmlBody = newBody If Not objMail.SendMail Then Call ssRaiseFatalError(err, Null, nof_Debug) exit sub End If Set objMail = Nothing else Err.Raise 110, "ss_getPassword_post.main.76", ssGetLocaleString("Error.110", Null) Call ssRaiseFatalError(err, Null, nof_Debug) exit sub end if '//checks if success page is a valid url to go to dim fso set fso = Server.CreateObject("Scripting.FileSystemObject") if fso.FileExists( Server.MapPath("../" & GetNextCurrentPage(ssGetProperty(ComponentNode, compGeneralTags.Item("nextpage")))) ) then response.write "" & vbcrlf else response.write "" & vbcrlf end if else propValue = "" set errEvent = getErrorEvent(ComponentNode, "email", "emailnotfound") if not errEvent is nothing then propValue = ssGetProperty(errEvent, "message") end if errLocal = "
" call ssBuildHiddenField(nof_ComponentID & "_" & "emailErrImg", ssGetProperty(ComponentNode, compGeneralTags.Item("errormark"))) end if end if call ssBuildHiddenField(nof_ComponentID & "_" & "Errors", errLocal) %>
<% end sub %>