<%option explicit%>
<%
Const EbayDisplay="No"
ShopCheckAdmin "shopa_editdisplay.asp"
'**************************************************************************
' Shop administration Only
' Format list of Records in any table so that they can be viewed or deleted
' add sort facility, fields to display
' Version 4.00 Feb 2, 2002 Fix default delete for non english
' Default
' 4.50 a Oct 16, 2002
'**************************************************************************
dim mysql
Dim Fieldcount
Dim Headnames(6)
Dim ProcType
Dim SortType
Dim Sortfield
Dim SortUpDown
Dim Sortupdownnames(2)
Dim Sortupdownvalues(2)
Dim Sortupdowncount
Dim Procnames(3)
dim Procvalues(3)
Dim Fieldnames
Dim Fieldnamecount
Dim DisplayFields
Dim displayFieldCount
Dim DisplayField
Dim Idfield
Dim SelectField
Dim SelectValue
Dim maxfields
Dim i
Dim item
dim dbtable
Dim scriptresponder
dim fieldname
Dim rstemp
Dim dbc
dim SpecialFunction
Dim Continue
Dim SelectAll
'
'
SelectAll=""
SetSess "CurrentURL","shopa_editdisplay.asp"
AdminPageHeader
GetDatabase
GetTableName
If dbtable<>"" then ' no valid table
GetSpecialFunction
EditOpenDatabase dbc,database,dbtable
GetInput ' get all form fields
maxfields=6
ProcessSpecialRequests ' delete or mail requests
GenerateDisplayHeader ' Generate sort button etc
SetupResponders ' Different Responders for different tables
ShopopenRecordSet mysql, rstemp, mypagesize, mypage
GenerateTable ' write the tabe
Call PageNavBar (Mysql) ' put bottom navigation bar
rsTemp.close ' close database
set rstemp=nothing
ShopCloseDatabase dbc
end if
AdminPageTrailer ' Write admin trailer
'
Sub GetDatabase
Database=request("database")
if database="" then
database=GetSess("db")
else
SetSess "db",database
end if
if database="" then
Debugwrite "No database specified"
end if
end sub
Sub GetTableName
dbtable=Request("Table")
if dbtable="" then
dbtable=GetSess("table")
else
ValidateTable
end if
if dbtable="" then
Response.write LangEditSelectFail & " "
exit sub
end if
SetSess "table",dbtable
'Response.write LangEdittablename & " = " & dbtable & " "
end sub
Sub GetSpecialFunction
specialfunction=Request("Specialfunction")
if specialfunction="" then
specialfunction=GetSess("specialfunction")
If Specialfunction="" then
specialfunction=LangCommonDelete
setsess("specialfunction"),specialfunction
end if
else
If ucase(Specialfunction)="NULL" then
SpecialFunction=""
end if
end if
SetSess "specialfunction",specialfunction
end sub
'**************************************************************************
Sub GetInput
mypage = Request("page")
'first time we need everything, othertimes sql is set up
sortfield=request("Sortfield")
' See how we are sorting
If Sortfield="" or Sortfield=LangCommonSelect then
sortfield=IdField
end if
SelectValue=request("Selectvalue")
SelectField=request("selectField")
If SelectField=LangCommonselect then
selectvalue=""
end if
'response.write "sortfield="& sortfield & " "
' see which types processed or unprocessed
SortUpdown=request("SortUpdown")
If SortUpdown="" then
sortupdown="ASC"
end if
if mypage="" then
SetFieldNames ' field names for table
GetDisplayfields
mypage=1
GenerateSQL
else
Mysql=Getsess("sqlquery")
Fieldcount=GetSess("Fieldcount")
Fieldnames=GetsessA("Fieldnames")
sortfield=GetSess("sortfield")
sortupdown=GetSess("sortupdown")
IDfield=GetSess("IDfield")
dbtable=GetSess("table")
DisplayFields=GetSess("DisplayFields")
DisplayFieldCount=GetSess("DisplayFieldCount")
end if
maxrecs=getconfig("xeditdisplaymaxrecords")
mypagesize=maxrecs
SetUpDown
' see if mail of export
If Request("SelectAll")<>"" then
SelectAll=" checked "
end if
database=Getsess("db")
end sub
'
' SQL is generate by using fields on form
Sub GenerateSQL
dim sqlproc
dim key
dim sqladd
sqladd=" Where"
MySql = "SELECT * from " & lcase(dbtable)
if Selectvalue<> "" then
key = SelectValue & "%"
mySQL = MySQL & " where " & SelectField & " like '" & key & "'"
sqladd=" AND "
end if
If ucase(dbtable)="PRODUCTS" then
DoRestrictProducts MySQL, sqladd
end if
If sortfield="" then sortfield=idfield
If sortfield<>"" then
mysql=mysql & " order by " & sortfield & " " & sortupdown
end if
SetSess "sqlquery",MySQL
Setsess "sortfield",sortfield
Setsess "sortupdown",sortupdown
'response.write "generated sql=" & mysql & " "
End sub
'
Sub DorestrictProducts (isql, sqladd)
if getconfig("XAdminRestrictProducts")<>"Yes" then exit sub
If GetSess("Admintype")="" then exit sub
If GetSess("Admintype")="SUPER" then exit sub
iSql = isql & sqladd & " userid='" & GetSess("shopadmin") & "'"
end sub
Sub GenerateTable()
dim howmanyfields
dim my_link
Dim howmanyrecs
Dim ArrayFields
Dim fieldvalue
SetSess "Table",dbtable
SetSess "Dbname",dbname
SetSess "Idfield",idfield
SetSess "Fieldcount",fieldcount
If DisplayFieldcount> 0 then
howmanyfields=DisplayFieldCount-1
ArrayFields=DisplayFields
else
howmanyfields=fieldcount-1
ArrayFields=Fieldnames
end if
'DebugWrite "fieldcount = " & fieldcount & "howmany=" & howmanyfields
if howmanyfields > maxfields then
howmanyfields = maxfields
end if
response.write "" & LangCommonPage & mypage & LangCommonOf & maxpages & ""
response.write "
"
%>
")
'
end sub
Sub SetFieldNames
Fieldnamecount=0
dim fSql
dim rs
dim fldname
ReDim Fieldnames(200)
FSQL = "SELECT * FROM " & lcase(dbtable)
'debugwrite fSQL
Set rs = dbc.Execute(fSQL)
For each fldName in rs.Fields
Fieldnames(fieldcount)=fldName.Name
' debugwrite fieldnames(fieldcount) & " "
fieldcount=fieldcount+1
next
rs.close
Idfield=Fieldnames(0)
SetSessA "Fieldnames",Fieldnames
DisplayFields=Fieldnames
Displayfieldcount=fieldcount
SetSessA "DisplayFields",Displayfields
SetSess "DisplayFieldCount",displayfieldCount
End Sub
Sub SetUpDown
Sortupdownnames(0)=LangAscending
Sortupdownnames(1)=LangDescending
Sortupdownvalues(0)="ASC"
Sortupdownvalues(1)="DESC"
SortUpDowncount=2
end sub
' *******************************************************
Sub DeleteRecord(Item)
dim Rowsaffected
dbc.Execute "delete from " & dbtable & " where " & idfield & "=" & Item, RowsAffected, 1
end sub
'*****************************************************
Sub GenerateDisplayHeader
GenerateSelection
'response.write " " & LangEdittablename & ": " & dbtable & " "
%>
<%
end sub
Sub GetDisplayFields
dim i
Dim displayArray(100)
DisplayFieldCount = Request("DisplayFields").Count
'Debugwrite DisplayfieldCount
if DisplayfieldCount=0 then
SetSess "Displayfieldcount",displayfieldcount
exit sub
end if
displayField=Request("DisplayFields")
DisplayFields= Split(DisplayField, ", ", -1, 1)
If DisplayFields(0)="All" then
Displayfieldcount=0
end if
SetSessA "DisplayFields",DisplayFields
SetSess "Displayfieldcount",displayfieldcount
end sub
'*****************************
Sub GenerateSelection
%>
<%
End sub
Sub ProcessSpecialRequests
if Request("All") <> "" then
SEtSess "Allrecords","Yes"
ProcessSpecialFunction
else
SetSess "AllRecords",""
end if
If Request("Selected")<>"" then
ProcessSpecialFunction
end if
end sub
Sub ProcessSpecialfunction
dim deletename
deletename=langcommonDelete & "User"
SpecialFunction=ucase(Request("SpecialFunction"))
If SpecialFunction=ucase(LangCommonDelete) Then
For each item in Request(Deletename)
DeleteRecord Item
Next
exit sub
End if
If Specialfunction=ucase(langSpecialMAIL) then
ProcessMail
exit sub
End if
If SpecialFunction=ucase(LangSpecialEXPORT) Then
ProcessExport
exit sub
End if
If SpecialFunction="EBAY" Then
ProcessEbay
exit sub
End if
end sub
Sub setupResponders
scriptresponder="shopa_editrecord.asp"
if ucase(dbtable)="PRODUCTS" then
if getconfig("xoldcategorymode")="Yes" Then
scriptresponder="shopa_addproductcompat.asp"
else
scriptresponder="shopa_addproduct.asp"
end if
end if
if ucase(dbtable)="SUBCATEGORIES" then
if getconfig("xoldcategorymode")="Yes" Then
scriptresponder="shopa_addsubcategory.asp"
end if
end if
if ucase(dbtable)="CATEGORIES" then
if getconfig("xoldcategorymode")="No" Then
scriptresponder="shopa_addcategory.asp"
end if
end if
end sub
'***************************************************************
Sub ProcessEbay
Dim ExportList
Dim Exporttype
SetSess "Table",dbtable
Exportlist=""
For each item in Request("EbayUser")
If Exportlist<>"" then
ExportList= Exportlist & "," & item
else
Exportlist=item
end if
Next
SetSess "ExportList",Exportlist
'DebugWrite "Ebaylist=" & Exportlist
Response.redirect "shopa_ebay.asp"
end sub
Sub ProcessExport
Dim ExportList
Dim Exporttype, exportname
setSess "Table",dbtable
Exportname=langspecialexport & "User"
Exportlist=""
Exporttype=GetSess("ExportType")
ExportType = ucase(left(exporttype,3))
For each item in Request(exportname)
If Exportlist<>"" then
ExportList= Exportlist & "," & item
else
Exportlist=item
end if
Next
SetSess "ExportList",Exportlist
shopclosedatabase dbc
Response.redirect "shopa_export.asp"
end sub
Sub ProcessMail
Dim MailList, mailname
mailname=LangSpecialmail & "User"
SetSess "Table",dbtable
Maillist=""
For each item in Request(Mailname)
If Maillist<>"" then
MailList=MailList & "," & item
else
MailList=item
end if
Next
SetSess "MailList",Maillist
Shopclosedatabase dbc
Response.redirect "shopa_mail.asp"
end sub
Sub ValidateTable
'********************************************
'See if user has access to this table
Dim UserTables
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 addSpecialLinks
dim my_link
If ucase(Dbtable)<>"REGISTRANT" then exit sub
my_link="shopgiftregformat.asp" & "?which=" & rstemp(idfield)
response.write ReportDetailColumn & "" & LangCommonView & "" & reportDetailColumnEnd
end sub
%>