<%option explicit%>
<%
ShopCheckAdmin "shopa_editdisplay.asp"
'*******************************
' Version 5.00 Supports adds, deletes, updates
' Display fields in one record of one table
' setting field to keyword "NULL" sets field to empty
' Jan 5, 2003
'*******************************
dim rstemp
dim which
dim idfield
dim dbtable, AddAction, conn, updateaction
dim DeleteAction
Addaction=Request.form("add")
Updateaction=Request.form("update")
Deleteaction=request("delete")
GetInputValues
If DeleteAction<>"" then
DeleteRecord
end if
EditOpenDatabase conn, database,dbtable
If Addaction = "" and Updateaction = "" Then
AdminPageHeader
GenerateForm
AdminPageTrailer
Else
AdminPageHeader
UpdateRecord
GenerateForm
AdminPageTrailer
end if
Shopclosedatabase conn
'************************
Sub GetInputValues
' ID, allows editing a record
which=request("which")
idfield=request("idfield")
dbtable=request("table")
ValidateTable
End Sub
'
Sub ValidateTable
'********************************************
'See if user has access to this table
Dim UserTables, i
dim tablecount
if getconfig("XRestrictAdminTables")<>"Yes" then exit sub
UserTables=GetSess("UserTables")
If Isnull(UserTables) then
exit sub
end if
if UserTables="" then
exit Sub
else
UserTables=split(GetSess("UserTables"),",",-1,1)
end if
tablecount=ubound(UserTables)
for i = 0 to tablecount
if ucase(dbtable)=ucase(Usertables(i)) then
exit sub
end if
next
dbtable=""
end sub
Sub GenerateForm
dim sqltemp
sqltemp="select * from " & dbtable
if which <> "" then
sqltemp=sqltemp & " where " & idfield & "=" & which
end if
'debugwrite sqltemp
set rstemp=conn.execute(sqltemp)
DisplayForm
rstemp.close
set rstemp=nothing
end Sub
'****************************
Sub DisplayForm()
dim keyvalue, howmanyfields, i, fieldname, fieldvalue, fieldtype, fieldtypenum
howmanyfields=rstemp.fields.count -1
shopwriteheader getlang("LangEdit02")
shopwriteerror sError
response.write "" & getlang("LangEditSelectSetup") & " " & dbtable & ""
response.write "")
AddImageupload
end sub
'************
'
Sub UpdateRecord
dim sqltemp
if getconfig("xMYSQL")="Yes" then
MYSQLProcessrecord updateaction, conn, dbtable, idfield, which
exit sub
end if
If updateaction<>"" then
sqltemp="select * from " & dbtable
sqltemp= sqltemp & " where " & idfield & "=" & which
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open sqltemp, conn, 1, 3
else
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open dbtable, conn, adOpenKeyset, adLockOptimistic
rstemp.AddNew
end if
GenerateUpdateSQL
which = rstemp(idfield)
rstemp.close
set rstemp=nothing
If addaction<>"" then
sError= sError & " " & getlang("LangProductAdded") & " " & which & ""
else
sError= sError & " " & getlang("LangEdit03") & ""
end if
end sub
' ******** general Sql
Sub GenerateUpdateSQL()
Dim howmanyfields
dim fieldname, fieldvalue, fieldtype
dim i, typename
howmanyfields=rstemp.fields.count -1
rstemp.update
for i=1 to howmanyfields
fieldname = rstemp(i).name
fieldtype=rstemp(i).type
fieldvalue = request.form(fieldname)
typename=GetTypename(fieldtype)
EUpdatefield fieldname,fieldvalue, fieldtype
next
rstemp.update
end sub
Sub EUpdateField (fieldname, fieldvalue, typename)
on error resume next
'Debugwrite fieldname & "value=" & fieldvalue
normalizefieldvalue fieldvalue, typename
if fieldvalue="" then
if which<>"" then
rstemp(Fieldname)=NULL
end if
exit sub
end if
if ucase(fieldvalue)="NULL" then
if which<>"" then
rstemp(Fieldname)=NULL
end if
else
rstemp(Fieldname)=fieldvalue
end if
end sub
Function GetTypeName(id)
Select Case id
Case "3"
GetTypeName = "Number"
Case "200"
GetTypeName = "Text"
Case "129"
GetTypeName = "Text"
Case "201","203"
GetTypeName = "Memo"
Case "6"
GetTypeName = "Currency"
Case "11"
GetTypeName = "YesNo"
Case "5"
GetTypeName = "Number"
Case "7", "133","134","135"
GetTypeName = "DateTime"
Case Else
GetTypeName = "Text"
End Select
End Function
Sub Normalizefieldvalue (value, itype)
dim uvalue
if itype="YesNo" then
if value="0" or value = "1" then exit sub
uvalue=ucase(value)
if uvalue="TRUE" or uvalue="YES" then
value=1
exit sub
end if
If uvalue="FALSE" then
value=0
exit sub
end if
value=0
exit sub
end if
end sub
Sub AddImageUpload
dim uploadurl, dbfield, fieldvalue
dbfield="catimage"
if getconfig("xupload")<>"Yes" then exit sub
If lcase(dbtable)<>"categories" then exit sub
uploadurl="shopa_upload.asp?id=" & which & "&field=" & dbfield & "&table=" & dbtable & "&idfield=" & idfield & "&url=" & server.urlencode("shopa_edit.asp")
Response.write "
"
end sub
Sub AddHiddenFields
Formathiddenfield "idfield",idfield
Formathiddenfield "which",which
Formathiddenfield "table",dbtable
end sub
Sub FormatHiddenField (fieldname, fieldvalue)
response.write "" & vbcrlf
end sub
Sub DeleteRecord
dim myconn
EditOpenDatabase myconn, database,dbtable
dim sql, url
sql="delete from " & dbtable & " where " & idfield & "=" & which
myconn.execute(sql)
shopclosedatabase myconn
url="shopa_editdisplay.asp?table=" & dbtable
response.redirect url
end sub
%>