<%option explicit%> <% ShopCheckAdmin "shopa_query.asp" '*********************************************************** ' VP-ASP Shop Administration ' General purpose query routine for any table in any database ' Version 6.50 Feb14, 2003 ' Do not allow tbluser ' Sept 2, 2003 Minor HTML error line 50 and close row '************************************************************* Dim dbtable Dim File Dim ScriptResponder Dim Dbc Dim Usertables Dim tablecount mypage="" AdminPageHeader GetInput If Request("query")<>"" or mypage<>"" then PerformSearch else GenerateSearchFields end if AdminPageTrailer '******************************** Sub GetInput dim pos ' need database and table file = Request.ServerVariables("SCRIPT_NAME") file = strReverse(file) pos = Instr(file,"/") file = Left(file, pos-1) file = strReverse(file) mypage=Request.querystring("page") end sub Sub GenerateSearchFields dim rs dim i Dim FieldType i=0 GenerateDisplayHeader getlang("LangQueryEnter") GenerateDisplayBodyHeader%>
">
<%GenerateDisplayBodyFooter Shopopendatabase dbc UserTables=GetSess("UserTables") if isNull (UserTables) then Usertables="" end if If UserTables="" then GetDatabaseTables UserTables, tablecount, dbc end if UserTables=split(GetSess("UserTables"),",",-1,1) tablecount=ubound(UserTables) tablecount=tablecount+1 GenerateDisplayHeader "How to use this page" GenerateDisplayBodyHeader%>

This page allows you to enter your own SQL SELECT query to view data from the database.

<%WriteExamples%>

<% for i = 0 to tablecount-1 dbtable = Usertables(i) Setuptable dbtable next response.write "
<%=getlang("LangQueryTables")%> <%=getlang("LangQueryFields")%>
" generatedisplaybodyfooter shopclosedatabase dbc end sub ' Sub setupTable (dbtable) Dim con, rs, fldname %><%=dbtable%><% EditOpenDataBase con,"", dbtable SQL = "SELECT * FROM " & lcase(dbtable) Set rs = con.Execute(SQL) dim count dim first count=0 first=TRUE Response.write Tablecolumn For each fldName in rs.Fields if first<>TRUE then response.write ", " else first=FALSE end if response.write fldName.Name count=count+1 if count> 5 then response.write "
" count=0 first=TRUE end if Next response.write TableColumnEnd response.write TableRowEnd rs.close set rs=nothing shopclosedatabase con end sub '************* Search database Sub PerformSearch generatedisplayheader "SQL Query Results" generatedisplaybodyheader Dim firsttime, rc dim strname dim Strvalue if mypage<>"" then SQL=GetSess("SQLQuery") GenerateTable SQL generatedisplaybodyfooter exit sub end if mypage=1 SQl=request("query") If SQL="" then shopwriteerror getlang("LangQueryNone") & "" generatedisplaybodyfooter exit sub end if Sql=replace(sql,vbcrlf,"") ValidateSql rc if rc>0 then exit sub SetSess "SQLQuery",SQL 'response.write GetSess("SQLQUERY") & "
" GenerateTable SQL generatedisplaybodyfooter end sub ' ' Generate table Sub GenerateTable(SQL) Dim rstemp,howmanyfields, idfield, i dim howmanyrecs maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs database="" EditOpenDatabase dbc, database,dbtable Response.write "" & sql & "

" 'on error resume next ShopopenRecordSet sql, rstemp, mypagesize, mypage if err.number> 0 then HandleError exit sub end if if rstemp.eof then shopwriteerror getlang("LangNoRecords") & "" generatedisplaybodyfooter rstemp.close set rstemp=nothing shopclosedatabase dbc GenerateSearchFields exit sub end if howmanyfields=rstemp.fields.count -1 idfield=rstemp(0).name setSess "idfield",idfield response.write getlang("LangCommonPage") & mypage & getlang("LangCommonOf") & maxpages & "
" Response.write "
" Response.write ReportTabledef Response.write "" for i=0 to howmanyfields Response.write ReportHeadColumn & rstemp(i).name & ReportHeadcolumnEnd next response.write ReportRowEnd howmanyrecs=0 DO UNTIL rstemp.eof OR howmanyrecs=maxrecs response.write ReportDetailRow for i = 0 to howmanyfields response.write ReportDetailColumn if isNull(rstemp(i)) then response.write " " else response.write rstemp(i) end if response.write ReportDetailColumnEnd next response.write ReportRowEnd howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rstemp.movenext end if loop response.write(ReportTableEnd) Call PageNavBar (sql) rstemp.close set rstemp=nothing shopclosedatabase dbc end sub Sub HandleError rc=0 If err.number > 0 Then rc=4 'Response.write "msg=" & msg & "
" Response.write("VBScript Errors Occurred:" & "

") Response.write("Error Number=" & err.number & "

") Response.write("Error Descr.=" & err.description & "

") Response.write("Help Context=" & err.helpcontext & "

") Response.write("Help Path=" & err.helppath & "

") Response.write("Native Error=" & err.nativeerror & "

") Response.write("Source=" & err.source & "

") Response.write("SQLState=" & err.sqlstate & "

") End If If dbc.errors.count> 1 then rc=4 Response.write "count=" & dbc.errors.count For counter= 0 to dbc.errors.count Response.write("Error #" & dbc.errors(counter).number & "

") Response.write("Error desc. -> " & dbc.errors(counter).description & "

") next End If end sub ' Sub WriteExamples %>

Examples of SQL
select * from categories
select * from products where cprice>10.00
select * from orders where olastname like '%buyer%'
select * from orders where odate=#01/05/00#

<% end sub Sub ValidateSQl (rc) dim i rc=0 Dim words(200), wordcount, delimiter delimiter=" " sql=sql & " " Parserecord sql,words,wordcount,delimiter if ucase(words(0))<>"SELECT" then sError="Only SELECT is allowed " & "

" shopwriteerror Serror rc=4 generatedisplaybodyfooter Exit sub end if for i = 0 to wordcount-1 if ucase(words(i))="FROM" then dbtable=trim(words(i+1)) exit for end if next ValidateTable dbtable if dbtable="" then shopwriteerror getlang("LangEditSelectFail") & "

" generatedisplaybodyfooter rc=4 exit sub end if End sub ' Sub ValidateTable (dbtable) '******************************************** 'See if user has access to this table Dim UserTables dim tablecount dim i If ucase(dbtable)="TBLUSER" then dbtable="" exit sub end if 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 ParseRecord (record,words,wordcount,delimiter) Dim pos Dim recordl Dim bytex Dim temprec Dim maxwords Dim i maxwords = 10 temprec = record Dim maxentries pos = 1 wordcount = 0 ' make sure word array is null maxentries = UBound(words) For i = 0 To maxentries - 1 words(i) = "" Next recordl = Len(temprec) ' first eliminate leading blanks Do bytex = Mid(temprec, pos, 1) While bytex = " " And pos <= recordl pos = pos + 1 bytex = Mid(temprec, pos, 1) Wend ' copy word into word array While bytex <> delimiter And pos <= recordl words(wordcount) = words(wordcount) & bytex pos = pos + 1 bytex = Mid(temprec, pos, 1) Wend wordcount = wordcount + 1 pos = pos + 1 If wordcount > maxentries Then Exit Sub Loop Until pos > recordl End Sub %>