<% Class PGDCustomReg Private mode_ Private formElements_ Private validationElements_ Private jsElements_ Private mem_ Private Sub Class_Initialize mode_ = "" formElements_ = "" validationElements_ = "" jsElements_ = "" End Sub Public Property Let mode(val) SELECT Case lcase(val) Case "register", "editprofile" mode_ = val call GenerateElements Case "showprofile" mode_ = val call GenerateElements Case Else response.end End SELECT End Property Public Property Let mem(val) mem_ = cLng(val) End Property Private Sub GenerateElements Dim strSQL, objRS, allData,i if mode_ = "register" then ' 0 1 2 3 4 5 6 7 strSQL = "SELECT fldTitle, HTMLInterface, HTMLValue, regExp, errorMessage, fID, fldNAme,example "&_ "FROM pgd_regDefinition WHERE isActive = 1 And onRegister = 1 ORDER By sortOrder" set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 37 .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then allData = .getrows End if .close end with set objRS=nothing if isArray(allData) then for i = 0 to ubound(allData,2) formElements_ = formElements_ &_ " " &_ " "&HTMLEncode(""&allData(0,i))&""&iff(len(allData(7,i)),"
"&HTMLEncode(""&allData(7,i))&"","")&"" & _ " " if allData(5,i)>32 then formElements_ = formElements_ &_ "" else if allData(1,i)=0 then formElements_ = formElements_ &_ "" validationElements_ = validationElements_ &_ ""&_ "" jsElements_ = jsElements_ &vbcrlf&_ "if (theForm.__"&allData(6,i)&") theForm.__"&allData(6,i)&".value = """®ExpEncode(allData(3,i))&""""&vbcrlf&_ "if (theForm._"&allData(6,i)&") theForm._"&allData(6,i)&".value = """&errEncode(""&allData(4,i))&""""&vbcrlf else Dim tempElement, arrValue, iArr, subArrValue tempElement = "" if isArray(arrValue) then erase arrValue if allData(1,i)=1 then 'select tempElement = "" else 'radio arrValue = Split(allData(2,i),vbcrlf) for iArr = 0 to ubound(arrValue) subArrValue = split(arrValue(iArr),":") tempElement = tempElement & _ " "&HTMLEncode(trim(""&subArrValue(1)))&"
" next end if formElements_ = formElements_ & tempElement end if end if formElements_ = formElements_ &_ " " & _ "" next end if validationElements_ = validationElements_ &_ "" elseif mode_="editprofile" then 'edit profile ' 0 1 2 3 4 5 6 7 8 9 strSQL = "SELECT fldTitle, HTMLInterface, HTMLValue, regExp, errorMessage, fID, fldNAme,example, allowHide, allowUpdate "&_ "FROM pgd_regDefinition WHERE isActive = 1 ORDER By sortOrder" set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 37 .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then allData = .getrows End if .close end with set objRS=nothing if isArray(allData) then Dim strAllFields, arrMemFields, arrFinalFields arrMemFields = ExtractOneDimension(allData,6) strAllFields = Join(arrMemFields,",") strSQL = "SELECT "&strAllFields&",h_"&replace(strAllFields,",",",h_")&" FROM pgd_regFields WHERE mem="&mem_ ' response.write strSQL ' response.end set objRS = server.createobject("adodb.recordset") with objRS .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then arrFinalFields = .getrows End if .close end with set objRS=nothing Dim dicFields : Set dicFields = Server.CreateObject("Scripting.Dictionary") if isArray(arrFinalFields) then for i = 0 to ubound (arrMemfields) dicFields.Add arrMemFields(i), arrFinalFields(i,0) dicFields.Add "h_"&arrMemFields(i), arrFinalFields((i+ubound(arrMemfields)+1),0) next else for i = 0 to ubound (arrMemfields) dicFields.Add arrMemFields(i), "" dicFields.Add "h_"&arrMemFields(i), "0" next end if ' Dim k ' for each k in dicFields.keys ' response.write k&":"&dicFields.item(k)&"
" ' next ' response.end Dim showField:showField=false Dim nonUpdateableFieldCount:nonUpdateableFieldCount =0 for i = 0 to ubound(allData,2) if (impersonate<>0) or allData(9,i)=1 or (isBMan or isUMan) then viewField = true else viewField = false if (impersonate<>0) or allData(8,i)<3 or (isBMan or isUMan) then formElements_ = formElements_ &_ " " &_ " "&HTMLEncode(""&allData(0,i))&""&iff(len(allData(7,i)),"
"&HTMLEncode(""&allData(7,i))&"","")&"" & _ " " if allData(5,i)>32 then 'textarea formElements_ = formElements_ &_ iff(allData(9,i)=1 or (isBMan or isUMan) or (impersonate<>0),"",_ HTMLEncode(""&dicFields.item(allData(6,i)))&"") else if allData(1,i)=0 then 'text field if viewField then formElements_ = formElements_ &_ "" validationElements_ = validationElements_ &_ ""&_ "" jsElements_ = jsElements_ &vbcrlf&_ "if (theForm.__"&allData(6,i)&") theForm.__"&allData(6,i)&".value = """®ExpEncode(allData(3,i))&""""&vbcrlf&_ "if (theForm._"&allData(6,i)&") theForm._"&allData(6,i)&".value = """&errEncode(""&allData(4,i))&""""&vbcrlf else formElements_ = formElements_ & HTMLEncode(""&dicFields.item(allData(6,i))) nonUpdateableFieldCount = nonUpdateableFieldCount+2 end if else tempElement = "" if isArray(arrValue) then erase arrValue arrValue = Split(allData(2,i),vbcrlf) if viewField then if allData(1,i)=1 then 'select tempElement = "" else 'radio for iArr = 0 to ubound(arrValue) subArrValue = split(arrValue(iArr),":") tempElement = tempElement & _ " "&HTMLEncode(trim(""&subArrValue(1)))&"
" next jsElements_ = jsElements_ &vbcrlf&_ "if (theForm."&allData(6,i)&") validatorCheckRadio(theForm."&allData(6,i)&")"&vbcrlf end if formElements_ = formElements_ & tempElement else formElements_ = formElements_ & unupdateableFldValue(arrValue,""&dicFields.item(allData(6,i))) nonUpdateableFieldCount = nonUpdateableFieldCount+2 end if end if end if formElements_ = formElements_ &_ iff(allData(8,i)=1 and viewField,""&" "&profAdditionalHide,"") formElements_ = formElements_ &_ " " & _ "" showField = true else nonUpdateableFieldCount = nonUpdateableFieldCount+2 end if next if showField then _ formElements_ = _ " "& _ ""&profAdditional&""& _ " "&_ formElements_ end if validationElements_ = validationElements_ &_ "" elseif mode_="showprofile" then ' 0 1 2 3 4 strSQL = "SELECT fldTitle, HTMLInterface, HTMLValue, fldNAme, allowHide "&_ "FROM pgd_regDefinition WHERE isActive = 1 ORDER By sortOrder" set objRS = server.createobject("adodb.recordset") with objRS .CacheSize = 37 .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then allData = .getrows End if .close end with set objRS=nothing if isArray(allData) then arrMemFields = ExtractOneDimension(allData,3) strAllFields = Join(arrMemFields,",") strSQL = "SELECT "&strAllFields&",h_"&replace(strAllFields,",",",h_")&" FROM pgd_regFields WHERE mem="&mem_ ' response.write strSQL ' response.end set objRS = server.createobject("adodb.recordset") with objRS .open strSQL, datastore, , , adCmdText If not (.EOF or .BOF) then arrFinalFields = .getrows End if .close end with set objRS=nothing Set dicFields = Server.CreateObject("Scripting.Dictionary") if isArray(arrFinalFields) then for i = 0 to ubound (arrMemfields) dicFields.Add arrMemFields(i), arrFinalFields(i,0) dicFields.Add "h_"&arrMemFields(i), arrFinalFields((i+ubound(arrMemfields)+1),0) next else for i = 0 to ubound (arrMemfields) dicFields.Add arrMemFields(i), "" dicFields.Add "h_"&arrMemFields(i), "0" next end if ' Dim k ' for each k in dicFields.keys ' response.write k&":"&dicFields.item(k)&"
" ' next ' response.end showField = false for i = 0 to ubound(allData,2) Dim hiddenSetting:hiddenSetting = allData(4,i) Dim viewField:viewField = false SELECT Case hiddenSetting Case 0 viewField = true Case 1 if dicFields.item("h_"&allData(3,i)) = 0 or cStr(mem_)= memID then viewField = true end if Case 2 if cStr(mem_) = memID then viewField = true END SELECT if (isBMan or isUMan) then viewField = true if viewField then formElements_ = formElements_ &_ " " &_ " "&HTMLEncode(""&allData(0,i))&"" & _ " " if allData(1,i)=3 or allData(1,i)=0 then 'textarea formElements_ = formElements_ &_ HTMLEncode(""&dicFields.item(allData(3,i))) else tempElement = "" if isArray(arrValue) then erase arrValue arrValue = Split(allData(2,i),vbcrlf) formElements_ = formElements_ & unupdateableFldValue(arrValue,""&dicFields.item(allData(3,i))) end if formElements_ = formElements_ &_ " " & _ "" showField = true end if next if showField then _ formElements_ = _ " "& _ ""&profAdditional&""& _ " "&_ formElements_ end if end if End Sub Public Property Get jsElements jsElements = jsElements_ End Property Public Property Get formElements formElements = formElements_ End Property Public Property Get validationElements validationElements = validationElements_ End Property Private function regExpEncode(byVal str) str = replace(str,"\","\\") regExpEncode = str End function Private function errEncode(byVal str) str = replace(str,"\","\\") str = replace(str,"""","\""") errEncode = str End function Private function unupdateableFldValue(arr,str) Dim i, subArr for i=0 to ubound(arr) subArr = split(arr(i),":") if subArr(0) = str then unupdateableFldValue = subArr(1) exit function end if next end function End Class %>