<%
Call fhMan_Main(cgiDir, componentid)
Sub fhMan_Main(cgiDir, componentid)
On Error Resume Next
Dim propFile, writetodb, CustErr, pageSize
pageSize = 10
propFile = cgiDir & "FormsHandler.xml"
Dim XML
set XML = fhOpenXMLFile(Server.MapPath(propFile))
Dim ManagerNode
if XML is nothing then
Call fhRaiseFatalError(601)
Response.End
end if
set ManagerNode = fhGetNode(XML,,"Component", Array("name","id"), Array("manager", componentid), -1)
if ManagerNode is Nothing then
Call fhRaiseFatalError(400)
Response.End
end if
Dim CSVFileName
CSVFileName = fhGetProperty(ManagerNode, "dbpath")
Dim formsHandlerNode
set formsHandlerNode = fhGetByDBpath(XML, "formshandler", CSVFileName)
if formsHandlerNode is Nothing then
Call fhRaiseFatalError(400)
Response.End
end if
writetodb = fhGetProperty(ManagerNode,"writetodb")
Dim dbPath
dbPath = fhGetProperty(ManagerNode, "dbpath")
if dbPath = "" then
fhRaiseFatalError("526")
Response.End
end if
if dbPath <> "" then
if not inStr(1, dbPath, "\", 1) > 0 then
dbPath= Server.MapPath(cgiDir & dbPath)
end if
end if
Dim dbFields
Dim tableHead
dbFields = fhGetDBFields(formsHandlerNode)
if fhFileExist(dbPath) then
'check if the fields are the same
tableHead = fhGetLine(dbPath)
if LCase(dbFields) <> LCase(tableHead) then
fhCreateDB dbPath, dbFields
if err.number <> 0 then
call fhRaiseFatalError(err.number)
err.Clear()
Response.End
end if
tableHead = fhGetLine(dbPath)
end if
else
'create the database
if dbFields = "" then
call fhRaiseFatalError(600)
Response.End
end if
fhCreateDB dbPath, dbFields
if err.number <> 0 then
call fhRaiseFatalError(err.number)
err.Clear()
Response.End
end if
tableHead = fhGetLine(dbPath)
end if
Dim act, un, rd, page, chkAll, msg, fieldDisable, changed
msg = ""
fieldDisable = ""
%>
<%
Dim Uploader
Dim File
Dim fileFields
Dim fileToUpload
Set Uploader = New FileUploader
Uploader.Upload()
if Len(Uploader.Form("page")) > 0 then
page = Uploader.Form("page")
else
page = 1
end if
Dim curAction
curAction = Uploader.Form("act")
if curAction = "AddForm" OR curAction = "AddRec" OR _
(curAction = "EditForm" AND Len(Uploader.Form("SelectedItem")) > 0 ) OR _
(curAction = "ViewForm" AND Len(Uploader.Form("SelectedItem")) > 0 ) OR _
curAction = "SaveRec" then
Dim record
Dim ui
Dim newFieldValue
Dim errFlag
Dim fieldErr
Dim btnName
btnName = "AddRec"
Dim recNr
recNr = 0
Dim relPath, path
relPath = fhGetProperty(ManagerNode, "uploaddir")
path = ""
if relPath = "." then
relPath = cgiDir
path = Server.MapPath(relPath) & "\"
elseif relPath <> "" then
relPath = cgiDir & relPath & "/"
path = Server.MapPath(relPath) & "\"
end if
if curAction <> "AddForm" and curAction <> "AddRec" then
recNr = Uploader.Form("SelectedItem")
if inStr(recNr, ",") then
recNr = CLng(split(recNr, ",")(0))
end if
btnName = "SaveRec"
end if
Dim allTHeads
allTHeads = split(tableHead,",")
fileFields = ","
for i=0 to UBound(allTHeads)
fieldName = allTHeads(i)
set errEvent = fhGetErrorEvent(formsHandlerNode, fieldName, "invalidextension")
if not errEvent is nothing then
fileFields = fileFields & allTHeads(i) & ","
end if
next
%>
<% else
'show users list'
if ( curAction = "EditForm" OR curAction = "ViewForm" OR _
curAction = "delete" ) AND Len(Uploader.Form("SelectedItem")) = 0 then %>
You must select a user first!
<% elseif curAction = "delete" then
dim items
items = Split(Uploader.Form("SelectedItem"), ",")
set rs = fhRSFileContent(dbPath, "all")
for i=0 to UBound(items)
if fhRecordExist(Trim(items(i))) then
r = 0
with rs
.MoveFirst
do while not .EOF
r = r + 1
if r = Clng(Trim(items(i))) then
.Delete
.Update
exit do
end if
.MoveNext
loop
end with
end if
next
if fhUpdateDB(dbPath, rs) then
else
call fhRaiseFatalError("502")
Response.End
end if
rs.close
end if
%>