<%option explicit%> <% ShopCheckAdmin "" const xeditdisplaymaxrecords="60" '************************************************************************** ' Shop administration Only ' Mass stock updating ' Version 6.50 Jan 22, 2004 '************************************************************************** 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 captions(10) Dim i Dim item dim dbtable Dim scriptresponder dim fieldname Dim rstemp Dim dbc dim SpecialFunction Dim Continue Dim SelectAll dim Action Dim RowsInTable ' Action = Request("Update") RowsInTable = Request("RowsInTable") SortField = Request("SortField") if SortField = getlang("LangCommonSelect") OR SortField = "" then SortField = "catalogid" end if SelectField = Request("SelectField") SelectValue = Request("SelectValue") AdminPageHeader if Action <> "" then UpdateStockDetails shopwriteheader getlang("LangAddUpdate") end if maxfields=8 maxrecs=getconfig("xeditdisplaymaxrecords") mypage = Request("page") if mypage = "" then mypage=1 validateSelect else sortfield=GetSess("sortfield") SelectField=GetSess("SelectField") SelectValue=GetSess("SelectValue") end if SelectAll="" mypagesize=maxrecs database=GetSess("db") dbtable = "products" ' SetSess "CurrentURL","shopa_editstock.asp" SetFieldNames GetDisplayFields generatedisplayheader "Update Stock" generatedisplaybodyheader GenerateSearchHeader generatedisplaybodyfooter generatedisplayheaderflat generatedisplaybodyheader EditOpenDatabase dbc,database,dbtable GenerateSql ShopopenRecordSet mysql, rstemp, mypagesize, mypage GenerateTable ' write the tabe 'VP-ASP 6.50 - moved this line further down 'Call PageNavBar (Mysql) ' put bottom navigation bar rsTemp.close ' close database set rstemp=nothing ShopCloseDatabase dbc generatedisplaybodyfooter AdminPageTrailer ' Write admin trailer '************************************************************************** '**** Sub GenerateSQL '************************************************************************** Sub GenerateSQL dim sqlproc dim key dim sqladd mysql = "select ccode,cname,cprice,cstock, ccategory, catalogid, cimageurl, extendedimage, retailprice from products " if SelectField = "ccode" or SelectField = "cname" then MySql = MySql & "WHERE " & SelectField & " LIKE '" & replace(SelectValue,"'","''") & "%'" elseif SelectField = "cprice" or SelectField = "retailprice" or SelectField = "cstock" or SelectField = "cimageurl" or SelectField = "extendedimage" or SelectField = "ccategory" or SelectField = "catalogid" then MySql = MySql & "WHERE " & SelectField & " = " & SelectValue end if mysql = mysql & " order by " & sortfield SetSess "sqlquery",MySQL Setsess "sortfield",sortfield Setsess "sortupdown",sortupdown Setsess "SelectField",SelectField Setsess "SelectValue",SelectValue 'response.write "generated sql=" & mysql & "
" End sub '************************************************************************** '**** Sub GenerateDisplayHeader '************************************************************************** Sub GenerateSearchHeader %>
<%=getlang("LangEditSelect")%> <%GenerateSelectNV Fieldnames,SelectField,"SelectField", fieldcount, getlang("LangCommonSelect")%>
<%=getlang("LangEditSort")%> <%GenerateSelectV fieldnames,fieldnames,sortfield,"sortfield", fieldcount, getlang("LangCommonSelect")%> ">
<% end sub '************************************************************************** '**** Sub GenerateTable '************************************************************************** Sub GenerateTable() dim howmanyfields Dim howmanyrecs dim my_link Dim ArrayFields Dim fieldvalue dim RowCount, fldCCode, fldCName, fldCPrice, fldRetailPrice, fldCStock, fldCCategory, fldcatalogid, fldextendedimage, fldcimageurl 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 'VP-ASP 6.50 - moved this line further down 'response.write "

" & getlang("LangCommonPage") & mypage & getlang("LangCommonOf") & maxpages & "

" response.write "" %>
<%=getlang("LangCommonPage") & mypage & getlang("LangCommonOf") & maxpages%> <%Call PageNavBar (Mysql) ' put bottom navigation bar%>
<% '*** Write column headings response.write ReportTableDef & "" for i=0 to howmanyfields ' response.write ReportHeadColumn & Captions(i) & reportHeadColumnEnd response.write ReportHeadColumn SortHeader Captions(i),Fieldnames(i) response.write reportHeadColumnEnd next Response.write "" '*** Write a page of records RowCount = 0 howmanyrecs=0 DO UNTIL rstemp.eof OR howmanyrecs=maxrecs response.write ReportDetailRow RowCount = RowCount + 1 fldCName = "cname" & RowCount fldCPrice = "cprice" & RowCount fldRetailPrice = "retailprice" & rowcount fldCStock = "cstock" & RowCount fldextendedimage = "extendedimage" & RowCount fldcimageurl = "cimageurl" & RowCount fldCCategory = "ccategory" & RowCount fldCatalogid = "catalogid" & RowCount Reportrow rstemp,fldcatalogid,"catalogid", 6,"readonly" ' Reportrow rstemp,fldccode,"ccode", 8,"" Reportrow rstemp,fldcname,"cname", 18,"" Reportrow rstemp,fldcprice,"cprice", 8,"" reportrow rstemp,fldretailprice,"retailprice", 8,"" Reportrow rstemp,fldcstock,"cstock", 5,"" Reportrow rstemp,fldcimageurl,"cimageurl", 18,"" Reportrow rstemp,fldextendedimage,"extendedimage", 18,"" Reportrow rstemp,fldccategory,"ccategory", 6,"readonly" response.write "" howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rstemp.movenext end if loop RowsInTable = RowCount Response.write "" %>
<%=getlang("LangCommonPage") & mypage & getlang("LangCommonOf") & maxpages%> <%Call PageNavBar (Mysql) ' put bottom navigation bar%>
<% 'VP-ASP 6.50 - moved to different location in file ' response.write "

"' ' response.write "

" Response.write("
") end sub Sub reportrow (rstemp,rowname, dbfield, rowsize,readonly) dim tempfield tempfield=rstemp(dbfield) if isnull (tempfield) then tempfield="" end if tempfield = Replace(tempfield, Chr(34), """) response.write ReportDetailColumn If readonly="" then response.write "" & ReportDetailColumnEnd else response.write tempfield & ReportDetailColumnEnd response.write "" & ReportDetailColumnEnd end if end sub '************************************************************************** '**** Sub SetFieldNames '************************************************************************** Sub SetFieldNames Fieldcount=8 ReDim Fieldnames(Fieldcount) Fieldnames(0)= "catalogid" Fieldnames(1)= "cname" Fieldnames(2)= "cprice" Fieldnames(3)= "retailprice" Fieldnames(4)= "cstock" Fieldnames(5)= "cimageurl" Fieldnames(6)= "extendedimage" Fieldnames(7)= "ccategory" Captions(0)= "catalogid" Captions(1)= getlang("LangProductName") Captions(2)= getlang("LangProductPrice") Captions(3)= getlang("LangProductRetailPrice") Captions(4)= getlang("LangProductCapStock") Captions(5)= getlang("LangProductImage") Captions(6)= getlang("LangProductExtendedImage") Captions(7)= getlang("LangSearchCategory") Idfield=Fieldnames(0) SetSessA "Fieldnames",Fieldnames DisplayFields=Fieldnames Displayfieldcount=fieldcount SetSessA "DisplayFields",Displayfields SetSess "DisplayFieldCount",displayfieldCount Sortupdownnames(0)=getlang("LangAscending") Sortupdownnames(1)=getlang("LangDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" SortUpDowncount=2 end sub '************************************************************************** '**** Sub DeleteRecord '************************************************************************** Sub DeleteRecord(Item) dim Rowsaffected dbc.Execute "delete from " & dbtable & " where " & idfield & "=" & Item, RowsAffected, 1 end sub '************************************************************************** '**** Sub UpdateStockDetails '************************************************************************** Sub UpdateStockDetails on error resume next dim sqlo dim StockConnect, Stockrs, StockSql dim RowCount, fldCCode, fldCName, fldCPrice, fldRetailPrice, fldCStock, fldCCategory, fldcatalogid, fldextendedimage, fldcimageurl dim valCCode, valCName, valCPrice, valRetailPrice, valCStock, valCCategory, valcatalogid, valextendedimage, valcimageurl ShopOpenDatabaseP StockConnect for RowCount = 1 to RowsInTable fldcatalogid="catalogid" & Rowcount fldCCode = "ccode" & RowCount fldCName = "cname" & RowCount fldCPrice = "cprice" & RowCount fldRetailPrice = "retailprice" & RowCount fldCStock = "cstock" & RowCount fldcimageurl = "cimageurl" & RowCount fldextendedimage = "extendedimage" & RowCount fldCCategory = "ccategory" & RowCount valcatalogid=request(fldcatalogid) valCCode = Request(fldccode) valCName = Request(fldCName) valCPrice = Request(fldCPrice) valRetailPrice = Request(fldRetailPrice) valCStock = Request(fldCStock) valcimageurl = Request(fldcimageurl) valextendedimage = Request(fldextendedimage) valCCategory = Request(fldCCategory) stocksql="update products " sqlo="" updatestock sqlo, "cname",valcname,"" updatestock sqlo, "cprice",valcprice,"Yes" updatestock sqlo, "retailprice",valretailprice,"Yes" updatestock sqlo, "cstock",valcstock,"Yes" updatestock sqlo, "cimageurl",valcimageurl,"" updatestock sqlo, "extendedimage",valextendedimage,"" updatestock sqlo, "ccode",valccode,"" stocksql=stocksql & sqlo stocksql=stocksql & " where catalogid=" & valcatalogid if getconfig("xdebug")="Yes" then debugwrite stocksql end if stockconnect.execute(stocksql) next ShopCloseDatabase StockConnect end sub ' sub Updatestock (sql, fieldname,fieldvalue, Numtest) if fieldvalue="" then fieldvalue="NULL" end if If sql="" then sql="SET " else sql= sql & "," end if If fieldvalue="NULL" then sql=sql & fieldname & "=NULL" exit sub end if fieldvalue = Replace(fieldvalue, "'", "''") If numtest<>"" then sql=sql & fieldname & "=" & fieldvalue else sql=sql & fieldname & "='" & fieldvalue & "'" end if end sub '************************************************************************** '**** Sub GetDisplayFields '************************************************************************** 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 ValidateTable '************************************************************************** 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 ValidateSelect If selectField<>getlang("Langcommonselect") then if selectvalue="" then selectfield=getlang("Langcommonselect") end if end if end sub %>