%
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_ &_
"
"
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_ &_
"
"
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
%>