<%option explicit%> <% ShopCheckAdmin "shopa_editdisplay.asp" '******************************* ' Version 4.00 ' Display fields in one record of one table ' setting field to keyword "NULL" sets field to empty ' Nov 17, 2001 '******************************* dim rstemp dim which dim idfield dim dbtable, sAction, conn sAction=Request.form("Action") if sAction="" then sAction=Request.form("Action.x") end if sError="" GetInputValues if dbtable="" then AdminPageHeader Response.write LangEditSelectFail & "
" AdMinPageTrailer else EditOpenDatabase conn, database,dbtable If sAction = "" Then AdminPageHeader GenerateForm AdminPageTrailer Else AdminPageHeader UpdateRecord GenerateForm AdminPageTrailer end if Shopclosedatabase conn end if '************************ Sub GetInputValues ' ID, allows editing a record which=request.querystring("which") idfield=request.querystring("idfield") dbtable=request.querystring("table") database=request.querystring("database") 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 " & lcase(dbtable) sqltemp=sqltemp & " where " & idfield & "=" & which 'Debugwrite sqltemp set rstemp=conn.execute(sqltemp) DisplayForm rstemp.close set rstemp=nothing end Sub '**************************** Sub DisplayForm() dim keyvalue, howmanyfields, i, fieldname, fieldvalue keyvalue=rstemp(idfield).value howmanyfields=rstemp.fields.count -1 %> ") AddImageupload response.write "

" end sub '************ ' Sub UpdateRecord if getconfig("xMYSQL")="Yes" then MYSQLEDITRecord exit sub end if dim sqltemp sqltemp="select * from " & dbtable sqltemp= sqltemp & " where " & idfield & "=" & which Set rstemp = Server.CreateObject("ADODB.Recordset") rstemp.open sqltemp, conn, 1, 3 'rstemp.open sqltemp, conn, adOpenKeyset, adLockOptimistic GenerateUpdateSQL rstemp.close set rstemp=nothing sError= sError & "
" & LangEdit03 & "" 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 rstemp(Fieldname)=NULL exit sub end if if ucase(fieldvalue)="NULL" then rstemp(Fieldname)=NULL 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" 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_editrecord.asp") Response.write "

" end sub %>