Modificare il file:
\dblist\_dblist_81.asp
<% '---------------------------------------------------------------------------------------- '- ASP dbList - Version 8.1 - 30 July 2005 '- Copyright © 2005 - Livio Siri (http://www.DaMa SOFTWARE) - All Rights Reserved. '---------------------------------------------------------------------------------------- '#################################################################################### 'controllare il percorso di uscita alla riga 772 '#################################################################################### '--- Funzioni --------------- sub w(sText) response.write sText & vbCrLf end sub '----------------- Sub re() Response.End End Sub '--- Funzione che sostituisce l'apostrofo Function Fixapos(data) fixapos = Replace(data,"'","''") end function '--- GetColDescription(strColName) Funzione----------------------------- Public Function GetColDescription(ByVal strColName) If Session("bGetCD") then Dim db Dim rsSchema Set db = Server.CreateObject("ADODB.Connection") Set rsSchema = Server.CreateObject("ADODB.Recordset") db.Open = dsn rsSchema.CursorType = 3 rsSchema.ActiveConnection = db Set rsSchema = db.openSchema(adSchemaColumns) do while (not rsSchema.EOF) if LCase(rsSchema("COLUMN_NAME")) = LCase(strColName) then If rsSchema("DESCRIPTION") <> "" then GetColDescription = rsSchema("DESCRIPTION") else GetColDescription = rsSchema("COLUMN_NAME") end if end if rsSchema.MoveNext loop rsSchema.Close Set rsSchema = Nothing db.Close Set db = Nothing Else GetColDescription = strColName End if End function '--- GetColDescription '--- GetFileName(strFilePath) Funzione----------------------------- Public Function GetFileName(ByVal strGetPath) Dim numPos, strFileName strFileName = "" strGetPath = cstr(strGetPath) if Not len(strGetPath) = 0 Then if InStr(strGetPath, "\") > 0 Then numPos = InStrRev(strGetPath, "\", Len(strGetPath)) elseif InStr(strGetPath, "/") > 0 Then numPos = InStrRev(strGetPath, "/", Len(strGetPath)) end if if numPos > 0 Then strFileName = Right(strGetPath, Len(strGetPath) - numPos) End if End if GetFilename = strFileName End function '--- GetFileName '----------------- Public Function ReturnDropDown(objConn, sSQL, intSelect, fieldname, fieldtype, IncludeBlank) Dim arrRS, i, bSQL, rsRecordSet, arrField set rsRecordSet = Server.CreateObject("ADODB.RecordSet") On error resume next rsRecordSet.Open sSQL, objConn, adOpenStatic, adLockReadOnly, adCmdText arrRS = rsRecordSet.GetRows rsRecordSet.Close set rsRecordSet = nothing On error goto 0 ReturnDropDown = ReturnDropDown & "<select name=""" & fieldname & """ onChange=""this.form.submit();""" & VbCrLf if (fieldtype = adLongVarChar) OR (fieldtype = adLongVarWChar) then ReturnDropDown = ReturnDropDown & " style="" width:300px;"">" & VbCrLf Else ReturnDropDown = ReturnDropDown & ">" & VbCrLf End if if includeBlank = true then ReturnDropDown = ReturnDropDown & "<option value="""">All</option>" if isArray(arrRS) then for i = 0 to uBound(arrRS, 2) if (arrRS(0,i)) <> "" then ReturnDropDown = ReturnDropDown & "<option value=""" & arrRS(0,i) & """" if cStr(arrRS(0,i)) = cStr(intSelect) then ReturnDropDown = ReturnDropDown & " selected Style=""color:white;background-color:#F00000;""" ReturnDropDown = ReturnDropDown & ">" & arrRS(0,i) & "</option>" & vbcrlf End if next end if ReturnDropDown = ReturnDropDown & "</select>" & VbCrLf end function '----------------- Display Tabella list ------------------------- Sub GetTable() Dim sSelect Dim rstSchema, db, objConn W "<Style type=""text/css""> select {font-family:Tahoma;font-size:10px;font-weight:bold;color:#000066;border-style:solid;border-color:#0066CC;background-color: #F6F6F6;}</style>" If Request.Querystring("table") <> "" Then Session("table") = Request.Querystring("table") Call dbList(strConn, Session("table"), "", DefaultSort, strProvider) Else w "<TABLE cellSpacing=0 cellPadding=2 border=0 align=center style=""border:solid 1px #999999;background-color:#FFFFFF;font-family:verdana;font-size:10px;"">" w "<TBODY><TR><td vAlign=top>" w "<TABLE cellSpacing=0 cellPadding=3 border=0 align=center style=""font-family:verdana;font-size:10px;""><TBODY><TR>" w "<td align=center bgcolor=#D9D9D9 WIDTH=26>" w "<a href=""" & Session("basereferer") & "?db=Select database"" title="" SELEZIONARE UN ALTRO ARCHIVIO "">" w "<img src=""" & strimgDir & "database.gif"" width=12 height=13 border=0 align=absmiddle alt="" SELEZIONARE UN ALTRO ARCHIVIO ""></a></td>" w "<td> <b>Archivio</b>: " If dbName <> "" Then w "<b Style=""color:#e00000;background-color:yellow;""> " & UCase(Session("db")) & " </b>" If Request.Querystring("db") = "Select database" then Session("db") = Null w "</td><form name=""Dir""><td valign=top>" If dbName = "" then Call Dir(autoPath) End if If Session("db") <> "" Then objConn = dsn w "</td></form><td align=right>" w " <b>Tabella</b>:" w "</td><form name=""Tab""><td valign=top>" Set db = Server.CreateObject("ADODB.Connection") On error resume next db.Open objConn If Err.Number <> 0 then w "<b>Errore:</b> " & Err.Description w "<b>Errore:</b> " & objConn response.end end if w "<select name=""table"" onChange=""this.form.submit();"">" & VbCrLf w "<option value=""Select table"">Seleziona tabella</option>" Set rstSchema = db.OpenSchema(adSchemaTables) Do Until rstSchema.EOF if UCase(rstSchema("TABLE_TYPE")) = "TABLE" then w "<option " & sSelect & "><a href=""" & Session("basereferer") & "?table=" & rstSchema("TABLE_NAME") & "&fieldSQL=reset"">" & rstSchema("TABLE_NAME") & "</a></option>" end if rstSchema.MoveNext Loop w "</select>" & VbCrLf rstSchema.Close Set rstSchema = Nothing db.Close On error goto 0 set db = nothing End if w "</td></form><td align=left nowrap style='text-decoration:none;color:NAVY;font-size:9px;'>" w " dbList v" & lVersion & " " w "<b><a href='' style='text-decoration:none;color:NAVY;font-size:9px;' Target=_new>DaMa SOFTWARE</a> </b>" w "</TD></TR></TBODY></TABLE>" w "</TD></TR></TBODY></TABLE>" End if End sub '----------------- Display Tabella list ------------------------- Sub Getdb() Dim sSelect Session("table") = Request.Querystring("table") w "<TABLE cellSpacing=0 cellPadding=0 border=0 style=""font-family:verdana;font-size:10px;""><TBODY><TR>" w "<td align=center bgcolor=#D9D9D9 WIDTH=56>" If dbName = "" Then w "<a href=""" & Session("basereferer") & "?db=Select database"" title="" SELEZIONA UN ALTRO ARCHIVIO "">" w "<img src=""" & strimgDir & "database.gif"" width=12 height=13 border=0 align=absmiddle alt="" SELEZIONA UN ALTRO ARCHIVIO ""></a> " Else w "<img src=""" & strimgDir & "database.gif"" width=12 height=13 border=0 align=absmiddle alt="" dbList DaMa SOFTWARE ""> " End if w "</td><td> <b>Archivio</b>:" If dbName <> "" Then w "<b Style=""color:#e00000;background-color:yellow;""> " & UCase(Session("db")) & " </b>" If Request.Querystring("db") <> "" then Session("db") = Request.Querystring("db") If Request.Querystring("db") = "Select database" then Session("db") = Null w "</td><form name=""Dir""><td valign=top>" If dbName = "" then Call Dir(autoPath) End if If Session("db") <> "" Then Dim rstSchema, db, objConn objConn = dsn w "</td></form><td align=right>" w " <b>Tabella</b>:" w "</td><form name=""Tab""><td valign=top>" Set db = Server.CreateObject("ADODB.Connection") On error resume next db.Open objConn If Err.Number <> 0 then w "<b>Errore:</b> " & Err.Description & "<br>" w "<b>Errore:</b> " & objConn response.end end if w "<select name=""table"" onChange=""this.form.submit();"">" & VbCrLf Set rstSchema = db.OpenSchema(adSchemaTables) Do Until rstSchema.EOF if UCase(rstSchema("TABLE_TYPE")) = "TABLE" then If rstSchema("TABLE_NAME") = Session("table") Then sSelect = " selected Style=""color:white;background-color:#F00000;""" Else sSelect = " style=""color:black;""" End if ' If rstSchema("TABLE_NAME") = Session("table") Then sSelect = " selected Style=""color:#e00000;background-color:yellow;""" Else sSelect = " style=""color:black;""" End if w "<option " & sSelect & "><a href=""" & Session("basereferer") & "?table=" & rstSchema("TABLE_NAME") & "&fieldSQL=reset"">" & rstSchema("TABLE_NAME") & "</a></option>" end if rstSchema.MoveNext Loop w "</select>" & VbCrLf rstSchema.Close Set rstSchema = Nothing db.Close On error goto 0 set db = nothing End if w "</TD></form></TR></TBODY></TABLE>" End sub '--------------------------------------------------------------------------------------------------------------- Sub Dir(byVal directory) Dim objFSO, currentFolder, objFile, currentFile, objFolder, sSelect Dim dbfile, ii, strdbfile, strColor, strColor1, strnextarrow w "<select name=""db"" onChange=""this.form.submit();"">" & VbCrLf w "<option value=""Select database"">Seleziona archivio</Option>" Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set currentFolder = objFSO.GetFolder(directory) For Each objFile In currentFolder.Files If lcase(right(objFile.name, 3)) = "mdb" then If objFile.name = Session("db") Then sSelect = " selected Style=""color:white;background-color:#F00000;""" Else sSelect = " style=""color:black;""" End if ' If objFile.name = Session("db") Then sSelect = " selected Style=""color:#e00000;background-color:yellow;""" Else sSelect = " style=""color:black;""" End if w "<option " & sSelect & "><a href='" & Session("basereferer") & "?db=" & objFile.name & "'>" & objFile.name & "</a></option>" End if Next Set currentFolder = Nothing Set objFSO = Nothing w "</select>" & VbCrLf End Sub '--------------------------------------------------------------------------------------------------------------- Private Function CompactDB(strProvider, strDbSource, autoPath, dBmain, boolIs97) Dim fso, Engine, strDBPath strDBPath = left(autoPath,instrrev(autoPath,"\")) Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(autoPath & dBmain) Then On error resume next Set Engine = CreateObject("JRO.JetEngine") If boolIs97 = "True" Then Engine.CompactDatabase strProvider & strDbSource, strProvider & autoPath & "temp.mdb;" & "Jet OLEDB:Engine Type=4" Else Engine.CompactDatabase strProvider & strDbSource, strProvider & autoPath & "temp.mdb" End If fso.CopyFile autoPath & "temp.mdb", autoPath &dbmain fso.DeleteFile(autoPath & "temp.mdb") If Err.number <> 0 Then Session("msg") = "<b style=""color:red;font-size:12px;"">ERRORE</b> : " & Err.description & " - (La cartella con gli archivi avrebbe dovuto avere i permessi di scrittura) " Else Session("msg") = "L'archivio, " & autoPath & dBmain & ", è stato Compattato" & vbCrLf End if Set Engine = nothing On error goto 0 Set fso = nothing Else Session("msg") = "Il nome dell'archivio o il percorso non è stato trovato. Riprova" & vbCrLf End If End Function '---CompactDB '--------------------------------------------------------------------------------------------------------------- Public Function dbList(strDbSource, strDbTable, strCondition, DefaultSort, strProvider) '************************************************* ' Procedure: dbList ' ' Returns: fills a sortable, pageable html table with records from a database ' with page navigating, editing, deleting, adding, exporting, filtering and searching capabilities ' ' Inputs: ' strDbSource = the database path (physical) ' strDbTable = the database table ' strCondition = Query Condition (ex: " WHERE Codice_Utente LIKE " & Session("USER_CODE")) ' DefaultSort = either desc or asc ' strProvider = ODBC provider ( ex. "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=") ' ' Usage: ' include this file in your ASP page ' Then call the function: '--- Usage: Call dbList(server.mappath("your_dB_path.mdb", "your_table_name", "your_SQL_WHERE_condition", your_Default_Sort, theConnProvider) ' ' Author: Livio Siri - http://www.DaMa SOFTWARE '************************************************* '##### CONFIGURATION ################################## rowColor1 = "#E0E0E0" '--- the db table alternate row color 1 --- rowColor2 = "#F0F0F0" '--- the db table alternate row color 2 --- strTRAttributes = "class=dbListTR" '--- the main table row TR attributes --- strTHAttributes = "class=dbListTH" '--- the table header TH attributes --- strTDAttributes = "class=dbListTD vAlign=top" '--- the table data TD attributes --- strNamesAttributes = "class=dbListNames" '--- the Column of Field Names attributes --- strNamesAttributesSort = "class=dbListNamesSort" '--- the Column of Sorted Field attributes --- objConn = strProvider & strDbSource & ";" '--- the connection string --- UpperNav = True '--- add the upper navigation bar --- Description = True '--- displays the description at table bottom --- SearchBox = True '--- add the search functions --- LowerNav = True '--- add the lower navigation bar --- '##### END CONFIG #################################### '---- Dim variables ----------------------------------------------------------------------------------------- Dim strDefaultSort, RS, strSort, intCurrentPage, strPageName, strTemp, field Dim strMoveFirst, strMoveNext, strMovePrevious, strMoveLast Dim i, j, intPageSize, intTotalPages, intCurrentRecord, intTotalRecords Dim nFrom, nTo, sele, sele1, sele2, intStart, intFinish, Sorting, Rpp Dim FieldsCount, strKeyWords, TheMode, strKeyWordsArray, MorethanOneKeywords Dim Wmax, StrOpenInContruction, strOpen, msg, sSort, cPKSort Dim strTRAttributes, strTHAttributes, strTDAttributes, objConn, strSQL Dim SearchBox, Description, strNamesAttributes, strNamesAttributesSort, rowColor1, rowColor2 Dim UpperNav, LowerNav, CheckIE, IE, rsS, bnorec, isPrimaryKey Dim mySQL, select1, select2, fieldSQL, strSQLString, sResetColor, sResetBGColor Dim rowColor, strPrimaryKey, db, rsSchema, bReturn '---- SchemaEnum Values ---- Const adSchemaIndexes = 12 If Len(strCondition) = 0 Then strSQL = "SELECT * FROM " & strDbTable '--- the default query string --- Else strSQL = "SELECT * FROM " & strDbTable & " WHERE (" & strCondition & ")" End if If Request.querystring("mystrSQL") <> "" Then strSQL = "SELECT * FROM " & strDbTable & " " & Request.querystring("mystrSQL") End if if Request.form("dSQL") <> "" Then If Session("debugSQL") = False Then Session("debugSQL") = True else Session("debugSQL") = False end if end if If ISNULL(Session("debugSQL")) Then Session("debugSQL") = debugSQL else debugSQL = Session("debugSQL") end if W "<Style type=""text/css"">" W "<!--" W "TR.dbListTR TD.dbListTR {Font-family:Verdana;font-weight:normal;font-size:10px;color:black;}" W "A.dbListTR {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTR:Link {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTR:Visited {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTR:Active {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTR:Hover {font-size:10px;text-decoration:none;font-family:Verdana,Tahoma,Arial;background-color: #FFFFCC;color:black;}" W "TH.dbListTH {font-size:10px;color:white;background-color:#436ea9;}" W "A.dbListTH {font-size:10px;color:white;text-decoration:underline;font-family:Tahoma,Arial;Verdana;}" W "A.dbListTH:Link {font-size:10px;color:white;text-decoration:none;font-family:Tahoma,Arial;}" W "A.dbListTH:Visited {font-size:10px;color:white;text-decoration:none;font-family:Tahoma,Arial;}" W "A.dbListTH:Active {font-size:10px;color:white;text-decoration:none;font-family:Tahoma,Arial;}" W "A.dbListTH:Hover {font-size:10px;text-decoration:none;font-family:Tahoma,Arial;background-color: #FFFFCC;color:black;}" W "TD.dbListTD {Font-family:Verdana;font-weight:normal;font-size:10px;color:black;}" W "A.dbListTD {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTD:Link {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTD:Visited {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTD:Active {font-size:10px;color:black;text-decoration:underline;font-family:Verdana,Tahoma,Arial;}" W "A.dbListTD:Hover {font-size:10px;text-decoration:none;font-family:Verdana,Tahoma,Arial;background-color: #FFFFCC;color:black;}" W "TH.dbListNames {font-size:10px;color:white;background-color:#385C8E;}" W "TH.dbListNamesSort {font-size:10px;color:white;background-color:#F00000;}" W "select {font-family:Tahoma;font-size:10px;font-weight:bold;color:#000066;border-style:solid;border-color:#0066CC;background-color: #F6F6F6;}" W "input {font-family:Tahoma;font-size:10px;font-weight:bold;color:#000066;padding-left:3px;padding-right:3px;background-color: #F6F6F6;}" W ".cflat {font-size:10px;font-family:Tahoma;background-color:#606060;color:#FFFFFF;font-weight:bold;cursor:hand;}" W ".cflat1 {font-size:10px;font-family:Verdana;background-color:#436ea9;color:#FFFFFF;font-weight:bold;cursor:hand;border:0px;height:12px;width:50px;}" W ".tflat {font-size : 10px; font-family : Verdana; BORDER-BOTTOM: 1px solid #080888; BORDER-LEFT: 1px solid #080888; BORDER-RIGHT: 1px solid #080888; BORDER-TOP: 1px solid #080888;}" W "SPAN.searchword { background-color:yellow; }" W "//-->" W "</style>" W "<script language=""javascript"" type=""text/javascript"">" W "<!--" W "function SelectPageTop (){" W "document.location = '" & strInc & "?sort=' + document.frmPage1.frmOrderBy.value + '&page=' + document.frmPage1.PageNbr.value + '&pagesize=' + document.frmPage1.frmRecordsPerPage.value + '&strKeyWords=' + document.frmPage1.frmKeyWords.value + '&mode=' + document.frmPage1.frmMode.value + '&table=' + document.frmPage1.Table.value;}" W "function SelectPageBottom (){" W "document.location = '" & strInc & "?sort=' + document.frmPage.frmOrderBy.value + '&page=' + document.frmPage.PageNbr.value + '&pagesize=' + document.frmPage.frmRecordsPerPage.value + '&strKeyWords=' + document.frmPage.frmKeyWords.value + '&mode=' + document.frmPage.frmMode.value + '&table=' + document.frmPage.Table.value;}" W "function SelectRecordsPerPageTop (){" W "document.location = '" & strInc & "?sort=' + document.frmRPP1.fOrderBy.value + '&pagesize=' + document.frmRPP1.RPP.value + '&strKeyWords=' + document.frmRPP1.fKeyWords.value + '&mode=' + document.frmRPP1.fMode.value + '&table=' + document.frmRPP1.Table.value;}" W "function SelectRecordsPerPageBottom (){" W "document.location = '" & strInc & "?sort=' + document.frmRPP.fOrderBy.value + '&pagesize=' + document.frmRPP.RPP.value + '&strKeyWords=' + document.frmRPP.fKeyWords.value + '&mode=' + document.frmRPP.fMode.value + '&table=' + document.frmRPP.Table.value;}" W "function clearfield(){" W "document.frmSearch.strKeyWords.value = '';}" W "function clearfieldfind(){" W "document.frmFind.q.value = '';}" W "var times = 0;" W "var hex = function(n){return (n<16?'0':'')+n.toString(16);};" W "function highlight( s, o ) {" W "if( !s ) { return 0; }" W "var d = document, f = d.forms.f.elements;" W "if( !f.regex.checked ) { s = s.replace( /([\\|^$()[\]{}.*+?])/g, '\\$1' ); }" W "if( /^\s*$/.test(s) ) { return 0; }" W "if( !f.phrase.checked ) { s = s.split( /\s+/ ).join( '|' ); }" W "o = [ o || d.documentElement || d.body ];" W "var r = new RegExp( s, f.cases.checked ? 'g' : 'gi' )," W "h = d.createElement('span'), i = 0, j, k, l, m, n=0, t;" W "times++;" W "h.style.color = '#000';" W "h.style.backgroundColor = '#'+( times%2 ? ''+hex((times%5)*51)+'ff' : 'ff'+hex(((times+1)%5)*51)+'' )+'00';" W "do {" W "m = o[i];" W "if( m.nodeType === 3 ) {" W "r.lastIndex = 0;" W "l = r.exec(m.nodeValue);" W "if( l !== null ) {" W "k = l[0].length;" W "if( r.lastIndex > k ) {" W "m.splitText( r.lastIndex - k );" W "m = m.nextSibling;}" W "if( m.nodeValue.length > k ) {" W "m.splitText(k);" W "o[i++] = m.nextSibling;}" W "t = h.cloneNode( true );" W "t.appendChild( d.createTextNode( l[0] ) );n++;" W "m.parentNode.replaceChild( t, m );}" W "} else {" W "j = m.childNodes.length;" W "while (j) { o[i++] = m.childNodes.item(--j); }}" W "} while(i--); return n;}" W "function unhighlight( s, o ) {" W "var d = document;" W "o = o || d.documentElement || d.body;" W "s = s.replace(/([\\|^$()[\]{}.*+?])/g, '\\$1');" W "var a = o.getElementsByTagName('span'), i = a.length, j," W "re = new RegExp( '^' + s + '$', 'i' );" W "while(i--) {" W "j = a[i].firstChild;" W "if( j ) {" W "if( j.nodeType === 3 && re.test( j.nodeValue ) ) {" W "a[i].parentNode.replaceChild( document.createTextNode( j.nodeValue ), a[i] );" W "}}}" W "return false;}" W "function hi(f) { f = f.elements;" W " f.find.value = highlight( f.q.value ) + 'x ' + f.q.value;" W " window.setTimeout( 'document.forms.f.elements.find.value="" CERCA "" ;', 3500 );return false;" W "}" W "function openit(){" W "var which='"&strIncPath&"info.asp'" W "whichit=window.open(which,'','width=350,height=300')" W "}" W "// -->" W "</script>" 'On error resume next If Request.form("compact") = "compact" Then w "<b style=""background-color:yellow;"">" CompactDB strProvider, strDbSource, autoPath, Session("db"), false w "</b>" End if w "<table border=0 cellspacing=0 cellpadding=2 style='border:solid 1px #999999;' bgcolor=#FFFFFF align=center><tr " & strTRAttributes & "><td " & strTRAttributes & ">" i = 0 strSort = request("sort") strPageName = Request.serverVariables("SCRIPT_NAME") intPageSize = request("pagesize") intCurrentPage = request("page") if intCurrentPage = "" then intCurrentPage = 1 end if '---- Check for Internet Explorer checkIE = True 'False if (checkIE) then if Instr(Request.ServerVariables("HTTP_USER_AGENT"), "IE") => 1 Then IE = True End if '---- find primary key field bReturn = False Set db = Server.CreateObject("ADODB.Connection") Set rsSchema = Server.CreateObject("ADODB.Recordset") db.Open objConn rsSchema.CursorType = 3 rsSchema.ActiveConnection = db Set rsSchema = db.openSchema(adSchemaIndexes) do while (not rsSchema.EOF) and (not bReturn) if LCase(rsSchema("TABLE_NAME")) = LCase(strDbTable) then if rsSchema("PRIMARY_KEY") then bReturn = True strPrimaryKey = rsSchema("COLUMN_NAME") & DefaultSort ' "desc" strDefaultSort = rsSchema("COLUMN_NAME") & DefaultSort ' "desc" end if end if rsSchema.MoveNext loop rsSchema.Close Set rsSchema = Nothing '---- if no Primary key field use the first table field as default if strDefaultSort = "" then Set rsS = Server.CreateObject("ADODB.Recordset") rsS.CursorLocation = 3 On error resume next rsS.Open strSQL, objConn, 3 for each field in rsS.Fields strPrimaryKey = field.name & DefaultSort ' "desc" strDefaultSort = field.name & DefaultSort ' "desc" exit for next rsS.Close On error goto 0 Set rsS = Nothing end if if strSort = "" then strSort = strDefaultSort end if db.Close Set db = Nothing '---- Open table ----------------------- set RS = server.CreateObject("adodb.recordset") with RS .CursorLocation=3 If instr(strSort, "desc") > 0 Then sSort = replace(strSort,"desc"," desc") else sSort = strSort If instr(strSort, "asc") > 0 Then sSort = replace(strSort,"asc"," asc") On error resume next .Open strSQL & " order by " & sSort, objConn, 3 If Err.number <> 0 Then If Err.number = -2147217900 Then w "<span STYLE=""font-family:verdana;font-size:11px;color:navy;"">" w "<B STYLE=""color:crimson;"">ERRORE: </b>Controllare se c'è un carattere di spazio nel nome della tabella (" & strDbTable & ").<br>" w "<B STYLE=""color:crimson;"">SOLUTIONE: </b>E'il caso di rinominare la tabella, senza spazi o seguire questaprocedura " W "<a href=""http://support.microsoft.com/?kbid=316975"" target=_blank style=""text-decoration:underline;color:blue;"">" w "ARTICLE</a> nella Knowledge Base Microsoft.<br>" End if w "<B STYLE=""color:crimson;"">ERRORE NUMBERO:</b> (" & Err.number & ")<br>" w "<B STYLE=""color:crimson;"">ERRORE DESCRIZIONE:</b> (" & Err.description & ")</span>" end if FieldsCount = .fields.count If request("strKeyWords") <> "" Then strKeyWords = fixapos(request("strKeyWords")) End if If request("mode") <> "" Then TheMode = request("mode") End if '--- Save strKeyWords into array" If instr(1,strKeyWords," ",1) > 0 then MorethanOneKeywords = "yes" strKeyWordsArray = Split(strKeyWords," ") Wmax = ubound(strKeyWordsArray) For i = 0 to Wmax if len(strKeyWordsArray(i)) < 3 then msg = " <span style=""font-size:10px;"">(Termine di ricerca <b style=""color:#f00000;"">" & strKeyWordsArray(i) & "</b> è troppo breve, per cui non è stato usato)</span>" strKeyWordsArray(i) = "" end if next end if '--- First we will get "StrOpen", wich is latter use to filter the database If MorethanOneKeywords = "yes" then if instr(1,strKeyWords," ",1) > 0 AND TheMode = "OR" then For i = 0 to Wmax if strKeyWordsArray(i) <> "" then For j = 1 to FieldsCount - 1 StrOpen= StrOpen & " OR " & .fields(j).name & " LIKE '%" & strKeyWordsArray(i) & "%'" next end if next end if if instr(1,strKeyWords," ",1) > 0 AND TheMode = "AND" then For j = 1 to FieldsCount - 1 StrOpenInContruction = "" For i = 0 to Wmax if strKeyWordsArray(i) <> "" then StrOpenInContruction = StrOpenInContruction & " AND " & .fields(j).name & " LIKE '%" & strKeyWordsArray(i) & "%'" end if next StrOpen = StrOpen & " OR (" & Right(StrOpenInContruction, Len(StrOpenInContruction) - 5) & ")" next end if For j = 1 to FieldsCount - 1 StrOpen = StrOpen & " OR " & .fields(j).name & " LIKE '%" & strKeyWords & "%'" next end if '--- Build the query to find keywords ---------------------------------- If strKeyWords <> "" AND instr(1,strKeyWords," ",1) = 0 then If Len(strCondition) = 0 Then strSQL = strSQL & " WHERE (" & .fields(0).name & " LIKE '%" & strKeyWords & "%'" Else strSQL = strSQL & " AND (" & .fields(0).name & " LIKE '%" & strKeyWords & "%'" End if For i = 1 To FieldsCount - 1 strSQL = strSQL & " OR " & .fields(i).name & " LIKE '%" & strKeyWords & "%'" next strSQL = strSQL & ")" Elseif strKeyWords <> "" AND instr(1,strKeyWords," ",1) > 0 Then If Len(strCondition) = 0 Then strSQL = strSQL & " WHERE (" & Right(StrOpen,Len(StrOpen) - 3) Else strSQL = strSQL & " AND (" & Right(StrOpen,Len(StrOpen) - 3) End if strSQL = strSQL & ")" Else strKeyWords = "" End if .Close '----------- field search -------------------------------------------------------------------- If instr(strSort, "desc") > 0 Then sSort = replace(strSort,"desc"," desc") else sSort = strSort If instr(strSort, "asc") > 0 Then sSort = replace(strSort,"asc"," asc") .Open strSQL & " order by " & sSort, objConn, 3 '---for each field in the recordset for each field in RS.Fields select1 = request("fieldname") select2 = request(field.name) If select1 = field.name Then Session(field.name) = select2 End if If len(Session(field.name)) > 0 Then if Session(field.name) = "True" then fieldSQL = fieldSQL & " AND " & field.name & " = " & Session(field.name) elseif Session(field.name) = "False" Then fieldSQL = fieldSQL & " AND " & field.name & " = " & Session(field.name) elseif IsNumeric(Session(field.name)) Then fieldSQL = fieldSQL & " AND " & field.name & " LIKE " & replace(Session(field.name), ",", ".") else fieldSQL = fieldSQL & " AND " & field.name & " LIKE '%" & fixapos(Session(field.name)) & "%'" End if Else Session(field.name) = Empty End if if request("fieldSQL") <> "" then Session(field.name) = "" next If fieldSQL > "" Then fieldSQL = " WHERE (" & right(fieldSQL, len(fieldSQL) - 5) & ")" if request("fieldSQL") <> "" then fieldSQL = "" End if .Close end with if instr(strSQL,"WHERE") > 0 then fieldSQL = replace(fieldSQL, "WHERE", "AND") end if If fieldSQL > "" Then strSQL = strSQL & " " & fieldSQL End if If instr(strSort, "desc") > 0 Then sSort = replace(strSort,"desc"," desc") else sSort = strSort If instr(strSort, "asc") > 0 Then sSort = replace(strSort,"asc"," asc") RS.Open strSQL & " order by " & sSort, objConn, 3 If RS.EOF Then bnorec = true If intPageSize = "" Then intPageSize = DefaultRecordsPerPage If RS.RecordCount > DefaultRecordsPerPage Then UpperNav = True '--- add the upper navigation bar --- Else UpperNav = False '--- remove the upper navigation bar --- End if If (Not(UpperNav) AND Not(LowerNav)) OR Ucase(intPageSize) = "ALL" Then intPageSize = RS.RecordCount If isNumeric(intPagesize) Then RS.PageSize = Cint(intPageSize) Else RS.PageSize = DefaultRecordsPerPage End if intTotalPages = RS.PageCount intCurrentRecord = RS.AbsolutePosition if not bnorec then RS.AbsolutePage = intCurrentPage end if intTotalRecords = RS.RecordCount intStart = RS.AbsolutePosition If intStart + RS.PageSize > RS.RecordCount Then intFinish = RS.RecordCount Else intFinish = intStart + (RS.PageSize - 1) End if strSQLString = strSQL '-------------------------------------------------------------- If Session("msg") <> "" Then w "<b style=""background-color:yellow;"">" & Session("msg") & "</b>" Session("msg") = "" End if if request("strKeyWords") <> "" then '--- show search result and words find ------------- w "<table border=0 CellSpacing=0 CellPadding=0 style='border:solid 1px #999999;'><tr " & strTRAttributes & "><td nowrap " & strTRAttributes & ">" w " Risultato della ricerca per parola chiave: </td><td " & strTRAttributes & ">" w "<b style=""color:#F00000;background-color:yellow;""> " & request("strKeyWords") & " </b> " w "</TD></TR></TABLE>" End if w "<table border=0 cellspacing=1 cellpadding=0 style=""border: solid 1px #999999;font-family:Verdana;font-size:7pt;color:NAVY;""><tr><td vAlign=top>" Call Getdb() w "</td><td nowrap> " w "<a href=""" &Request.servervariables("SCRIPT_NAME")&"?"&Request.querystring&""" title="" Aggiorna "">" w "<img src=""" & strimgDir & "refresh.gif"" name=""Refresh"" border=""0"" height=""17"" width=""15"" alt="" Aggiorna ""></a>" w "</td>" '--- Toggle hide columns management if Request("hf") = "ok" Then If Session("bHideField") = False Then Session("bHideField") = True else Session("bHideField") = False end if end if If ISNULL(Session("bHideField")) Then Session("bHideField") = bHideField else bHideField = Session("bHideField") end if w "<FORM name=""frmHideField"" action="""" method=POST><td nowrap valign=top> " w "<input type=""checkbox"" style=""cursor:hand;width:18px;height:18px;"" name=""hidefield"" value=""Enable"" onClick=""this.form.submit();""" If Session("bhidefield") Then w " checked style=""background-color:#F00000;"" title="" Disattivare Nascondi colonna funzione di campo "">" Else w " style=""background-color:#D9D9D9;"" title="" Nasconde la colonna funzione di campo "">" End if w "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" w "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" w "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" w "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" w "<input type=""hidden"" name=""pagesize"" value=" & request("pagesize") & ">" w "<input type=""hidden"" name=""hf"" value=""ok"">" w "</td></form>" '--- Column description insthead of column name management If bShowColDescription AND strDbType = "Access" Then if Request("gcd") = "ok" Then If Session("bGetCD") = False Then Session("bGetCD") = True else Session("bGetCD") = False end if end if If ISNULL(Session("bGetCD")) Then Session("bGetCD") = bShowColDescription else bShowColDescription = Session("bGetCD") end if w "<FORM name=""frmGetColDescription"" action="""" method=POST><td nowrap valign=top> " w "<input type=""checkbox"" style=""cursor:hand;width:18px;height:18px;"" name=""GetCD"" value=""Enable"" onClick=""this.form.submit();""" If Session("bGetCD") Then w " checked style=""background-color:#F00000;"" title="" Disabilita la visualizzazione della colonna descrizione "">" Else w " style=""background-color:#D9D9D9;"" title="" Abilitare la visualizzazione della colonna Descrizione "">" End if w "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" w "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" w "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" w "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" w "<input type=""hidden"" name=""pagesize"" value=" & request("pagesize") & ">" w "<input type=""hidden"" name=""gcd"" value=""ok"">" w "</td></form>" End if '--- Print all records management If bShowPrint Then W "<td nowrap valign=middle> " w "<a href=""" & strIncPath & "print.asp?Q=" & Server.Urlencode(strSQLString) & "&dsn=" & Server.Urlencode(dsn) & "&primarykey=" & Replace(strDefaultSort, DefaultSort, "") & "&strdbtable=" & strdbtable & """ target=""_blank"" title="" STAMPA TUTTI I RECORDS (con filtro) "">" w "<img src=""" & strimgDir & "print.gif"" name=""Print Record"" border=""0"" height=""15"" width=""15"" alt="" STAMPA TUTTI I RECORDS (con filtro) ""></a>" W "</td>" End if '--- if excel_export. true then display the command link If bExcel_export Then W "<td nowrap valign=middle> " w "<a href=""" & strIncPath & "excel_export.asp?objConn=" & objConn & "&strSQL=" & Server.Urlencode(strSQL) & "&strSort=" & strSort & """ target=_blank title="" SCARICA TUTTI I RECORD IN UN DOCUMENTO EXCEL (con filtro)"">" w "<img src=""" & strimgDir & "excel1.gif"" border=0 width=16 height=16 align=absmiddle alt="" SCARICA TUTTI I RECORD IN UN DOCUMENTO EXCEL (con filtro) ""> </a>" W "</td>" End if '--- Compact db management If strDbType = "Access" AND bShowCompact AND bEnableEdit Then w "<FORM name=""frmCompactDb"" action="""" method=POST><td nowrap valign=middle> " w "<input type=""image"" src=""" & strimgDir & "compact.gif"" height=""15"" width=""15"" align=""absmiddle"" alt="" COMPATTA ARCHIVIO " & session("db") &" "" border=0 style=""border:none;cursor:hand;width:15px;height:15px;"" value=""compact"" onClick=""this.form.submit();"">" w "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" w "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" w "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" w "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" w "<input type=""hidden"" name=""pagesize"" value=" & request("pagesize") & ">" w "<input type=""hidden"" name=""compact"" value=""compact"">" w "</td></form>" End if W "<td nowrap> " W "<a href='javascript:openit()'><img src=""" & strimgDir & "help.gif"" border=0 alt="" Informazioni sull'applicazione "" width=16 height=17></a>" ' ########################################## ' Modificato per visualizzare l'uscita '############################################ ' If bLogin Then '--- Show logout button ' w "</td><td nowrap valign=bottom> " ' W "<a href='?logout=yes'><img src=""" & strimgDir & "logout.gif"" border=0 alt="" Logout "" width=16 height=16></a>" ' End if '--- Show logout button w "</td><td nowrap valign=bottom> " ' W "<a href='?logout=yes'><img src=""" & strimgDir & "logout.gif"" border=0 alt="" Logout "" width=16 height=16></a>" W "<a href='http://www.martinucci-regali.com/admin/default.asp'><img src=""" & strimgDir & "logout.gif"" border=0 alt="" Logout "" width=16 height=16></a>" http://www.martinucci-regali.com/admin/default.asp 'End if w "</td><td nowrap style='text-decoration:none;color:NAVY;font-size:9px;'>" w " dbList v" & lVersion & " " w "<b><a href='' style='text-decoration:none;color:NAVY;font-size:9px;' Target=_new title=''>DaMa SOFTWARE</a> </b>" w "</td><td> " w "</td></tr></table>" w "<span style=""font-size:1px;""> </span><br>" '--- navigation routines -------------------------------- Dim strFirstp Dim strPrevp Dim strNextp Dim strLastp Dim strFirstpTitle Dim strPrevpTitle Dim strNextpTitle Dim strLastpTitle Dim strPagep Dim strOfp Dim strNorfp Dim strAll Dim strimgFirstMon Dim strimgPrevMon Dim strimgNextMon Dim strimgLastMon Dim strimgFirstMoff Dim strimgPrevMoff Dim strimgNextMoff Dim strimgLastMoff strPagep = "Pag. " strFirstpTitle = " Prima " strPrevpTitle = " Precedente " strNextpTitle = " Prossima " strLastpTitle = " Ultima " strOfp = " di " strAll = " Tutti i record visualizzati " strNorfp = "Nessun record trovato" strimgFirstMon = "2first.gif" '--- OnMouseOver strimgPrevMon = "2prev.gif" '--- OnMouseOver strimgNextMon = "2next.gif" '--- OnMouseOver strimgLastMon = "2last.gif" '--- OnMouseOver strimgFirstMoff = "22first.gif" '--- OnMouseOut strimgPrevMoff = "22prev.gif" '--- OnMouseOut strimgNextMoff = "22next.gif" '--- OnMouseOut strimgLastMoff = "22last.gif" '--- OnMouseOut strFirstp = "<img src=""" & strimgDir & strimgFirstMoff & """ align=absmiddle border=1 alt=""" & strFirstpTitle & strPagep &""" name=""strimgFirstTop"" style=""border-color:black;"">" strPrevp = "<img src=""" & strimgDir & strimgPrevMoff & """ align=absmiddle border=1 alt=""" & strPrevpTitle & "(" & strPagep & intCurrentPage - 1 & ")"" name=""strimgPrevTop"" style=""border-color:black;"">" strNextp = "<img src=""" & strimgDir & strimgNextMoff & """ align=absmiddle border=1 alt=""" & strNextpTitle & "(" & strPagep & intCurrentPage + 1 & ")"" name=""strimgNextTop"" style=""border-color:black;"">" strLastp = "<img src=""" & strimgDir & strimgLastMoff & """ align=absmiddle border=1 alt=""" & strLastpTitle & "(" & strPagep & intTotalPages & ")"" name=""strimgLastTop"" style=""border-color:black;"">" '--- give links to move between pages strMoveFirst = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=1&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes &_ " title="" Vai alla prima pagina """ & _ " onMouseOver=""document.strimgFirstTop.src='" & strimgDir & strimgFirstMon & "'""" & _ " onMouseOut=""document.strimgFirstTop.src='" & strimgDir & strimgFirstMoff & "'"">" & _ strFirstp & "</A> " strMovePrevious = "<a href=" & strPageName & "?table="& strDbTable &"&sort=" & strSort & "&page=" & intCurrentPage - 1 & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strPrevpTitle & "(" & strPagep & intCurrentPage - 1 & ")""""" & _ " onMouseOver=""document.strimgPrevTop.src='" & strimgDir & strimgPrevMon & "'""" & _ " onMouseOut=""document.strimgPrevTop.src='" & strimgDir & strimgPrevMoff & "'"">" & _ strPrevp & "</A> " strMoveNext = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=" & intCurrentPage + 1 & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strNextpTitle & "(" & strPagep & intCurrentPage + 1 & ")""""" & _ " onMouseOver=""document.strimgNextTop.src='" & strimgDir & strimgNextMon & "'""" & _ " onMouseOut=""document.strimgNextTop.src='" & strimgDir & strimgNextMoff & "'"">" & _ strNextp & "</A>" strMoveLast = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=" & intTotalPages & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strLastpTitle & "(" & strPagep & intTotalPages & ")""""" & _ " onMouseOver=""document.strimgLastTop.src='" & strimgDir & strimgLastMon & "'""" & _ " onMouseOut=""document.strimgLastTop.src='" & strimgDir & strimgLastMoff & "'"">" & _ strLastp & "</A>" select case cint(intCurrentPage) '---if there is only one last page then no links case cint(intTotalPages) If cint(intTotalPages) = 1 Then strMoveFirst = "" strMovePrevious = "" strMoveNext = "" strMoveLast = "" '---if its the last page give only links to movefirst and move previous else strMoveNext = "" strMoveLast = "" end if '---if its the first page only give links to move next and move last case 1 strMoveFirst = "" strMovePrevious = "" case 2 strMoveFirst = "" case cint(intTotalPages - 1) strMoveLast = "" '---if its a page in the middle give all links case else end select if UpperNav then '--- top of page navigation routines -------------------------------- with Response .Write "<table width='100%' border=0 cellpadding=0 cellspacing=0><tr><th " & strTHAttributes & ">" .Write "<table border=0 cellpadding=0 cellspacing=0 align=left>" .Write "<form action="""" method=""post"" name=""frmPage1"">" .Write "<tr><th " & strTHAttributes & " align=left vAlign=middle> " .Write strMoveFirst & " " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write strMovePrevious .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write " <span style=""font-weight:normal;""> Page:</span> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" '--- select page # if intTotalPages > 1 then .Write "<input type=""hidden"" name=""frmOrderBy"" value=" & strSort & ">" .Write "<input type=""hidden"" name=""frmRecordsPerPage"" value=" & intPageSize & ">" .Write "<input type=""hidden"" name=""frmKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" .Write "<input type=""hidden"" name=""frmMode"" value=" & TheMode & ">" .Write "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" .Write " <select name=""PageNbr"" onchange=""SelectPageTop()"">" for i = 1 to intTotalPages if CStr(i) = CStr(intCurrentPage) Then sele = " selected style=""color:#F00000;""" Else sele = " style=""color:black;""" End if .Write "<option value=" & CStr(i) & sele & "> " & CStr(i) & " </option>" next .Write "</select> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle style=""font-weight:normal;"">" .Write "of " & intTotalPages & " " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write strMoveNext & " " .Write strMoveLast Else '--- there is only one page .Write " 1 " End if .Write "</th></form>" '--- select records per page .Write "<form action="""" method=""post"" name=""frmRPP1"">" .Write "<th " & strTHAttributes & " align=left vAlign=middle>" .Write " - <span style=""font-weight:normal;"">Records/Pagina:</span> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" .Write "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" .Write "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" .Write "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" .Write "<select name=""RPP"" class=""inputbox"" onchange=""SelectRecordsPerPageTop()"">" If intTotalRecords > 10 Then If intPageSize = 10 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""10""" & sele1 & "> 10 </option>" End if If intTotalRecords > 25 Then If intPageSize = 25 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""25""" & sele1 & "> 25 </option>" End if If intTotalRecords > 50 Then If intPageSize = 50 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""50""" & sele1 & "> 50 </option>" End if If intPageSize <> 10 AND intPageSize <> 25 AND intPageSize <> 50 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""all""" & sele1 & "> TUTTI </option>" .Write "</select>" .Write "</th></form><th " & strTHAttributes & " align=left vAlign=middle>" If Cint(intPageSize) > 1 Then .Write " <span style=""font-weight:normal;""> - ( Records <b>" & intStart &_ "</b> di <b>" & intFinish & "</b> di <b>" & intTotalRecords & "</b> totali )</span>" End if .Write "</th></tr></table>" .Write "</td></tr></table>" End with End if '------ CORE ------------------------------------------------------------------------- if bHideFirstColumn then if instr(strPrimaryKey, "desc") > 0 then isPrimaryKey = replace(strPrimaryKey, "desc", "") elseif instr(strPrimaryKey, "asc") > 0 then isPrimaryKey = replace(strPrimaryKey, "asc", "") end if end if '--- show field names in the table header------------------------------------------------- w "<table align=center width='100%' border=0 CellSpacing=1 CellPadding=2 style='border:solid 1px #999999;'><tr>" If bEnableEdit Then w "<td " & strNamesAttributes & " align=center bgcolor=#D9D9D9 WIDTH=48 valign=top>" w "<a href=""?table="& strDbTable &"&action=add&url=" & GetFileName(Request.ServerVariables("URL")) & "&strdbsource=" & strdbsource & "&strdbtable=" & strdbtable & "&strdefaultsort=" & strDefaultSort & """ title="" AGGIUNGI NUOVO RECORD "">" w "<img src=""" & strimgDir & "u_plus_1.gif"" width=11 height=11 border=0></a><div style=""font-size:3px;""> </div>" w "<a href=""" & strPageName & "?table="& strDbTable &"&fieldSQL=reset""" If Request.QueryString("fieldname") <> "" OR request("strKeyWords") <> "" OR request.querystring("mystrSQL") <> "" then sResetColor = "#FFFFFF" sResetBGColor = "#F00000" Else sResetColor = "black" sResetBGColor = "#D1E0FD" End if w " style=""font-size:10px;color:"&sResetColor&";font-weight:bold;text-decoration:none;background-color:"&sResetBGColor&";border: solid 1px navy;CURSOR:HAND;WIDTH:50;""" w " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" w " onMouseout=""this.style.color='"&sResetColor&"'; this.style.background='"&sResetBGColor&"'; return true;""" w "title="" REIMPOSTA TUTTI I FILTRI ''TUTTI'' "">" w " RESET »</a></div>" w "</td>" End if '--- loop through the fields in the recordset for each field in RS.Fields '--- Set cookies to hold hidden fields If request("hidefield") = field.name AND request("fieldname") = field.name Then Response.Cookies("hidefield")(field.name) = True Else If request(field.name) = "" AND request("fieldname") = field.name Then Response.Cookies("hidefield")(field.name) = False End if End if Response.Cookies("hidefield").Expires=Now() + 30 '--- toggle hidden field control If not Request.Cookies("hidefield")(field.name) then if field.name <> isPrimaryKey OR NOT bHideFirstColumn then If strSort = field.name OR strSort = field.name & "desc" OR strSort = field.name & "asc" Then w "<FORM name=frmSearchField action="""" method=GET>" w "<th " & strNamesAttributesSort & " nowrap valign=top>" If Session("bHideField") Then w "<input type=""checkbox"" style=""cursor:hand;width:12px;"" title="" Nascondi campo " & field.name & " "" name=""hidefield"" value=""" & field.name & """ style=""background-color:#F00000;"" onClick=""this.form.submit();""" If Request.Cookies("hidefield")(field.name) Then w " verificato>" Else w ">" End if End if Else w "<FORM name=frmSearchField action="""" method=GET>" w "<th " & strNamesAttributes & " nowrap valign=top" If field.type = adLongVarWChar then w " width=300 valign=top>" else w " valign=top>" end if If Session("bHideField") Then w "<input type=""checkbox"" style=""cursor:hand;width:12px;"" title="" Nascondi campo " & field.name & " "" name=""hidefield"" value=""" & field.name & """ style=""background-color:#385C8E;"" onClick=""this.form.submit();""" If Request.Cookies("hidefield")(field.name) Then w " verificato>" Else w ">" End if End if End if if not isexcluded(field.type) then '--- check the sort order, if its currently ascending, make the link descending if instr(strSort, "desc") then w "<a href=" & strPageName & "?table="& strDbTable &"&sort=" & field.name & "&page=" & intCurrentPage &_ "&pagesize=" & intPageSize & "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode &_ " " & strTHAttributes & " title="" Clicca per mettere in ordine il campo: " & field.name & ", crescente "">" & GetColDescription(field.name) & "</a>" If strSort = field.name & "desc" Then w " <img src=""" & strimgDir & "sort_desc_1.gif"" width=10 height=7 border=0 alt="" ordine decrescente "">" '& chr(118) else '---ascending w "<a href=" & strPageName & "?table="& strDbTable &"&sort=" & field.name & "desc&page=" & intCurrentPage &_ "&pagesize=" & intPageSize & "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode &_ " " & strTHAttributes & " title="" Clicca per mettere in ordine il campo: " & field.name & ", crescente "">" & GetColDescription(field.name) & "</a>" If strSort = field.name Then w " <img src=""" & strimgDir & "sort_asc_1.gif"" width=10 height=7 border=0 alt="" Ordine crescente "">" '& chr(094) end if else w GetColDescription(field.name) end if w "<br>" mySQL = "SELECT DISTINCT " & field.name & " FROM " & strDbTable & " ORDER BY " & field.name if not isexcluded(field.type) AND field.type <> adLongVarWChar then w ReturnDropDown(dsn, mySQL, Session(field.name), field.name, field.type, true) end if w "<input type=""hidden"" name=""fieldname"" value=""" & field.name & """>" w "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" w "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" w "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" w "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" w "<input type=""hidden"" name=""pagesize"" value=" & request("pagesize") & ">" w "</th></form>" end if else w "<FORM action="""" method=GET>" w "<th " & strNamesAttributesSort & " nowrap valign=top>" w "<input type=""checkbox"" style=""cursor:hand;width:12px;"" title="" Mostra campo " & field.name & " "" name=""hidefield"" value=""" & field.name & """ style=""background-color:#F00000;"" onClick=""this.form.submit();""" If Request.Cookies("hidefield")(field.name) Then w " verificato>" Else w ">" End if ' w "<br><img src=""" & strimgDir & "qm1.gif"" width=12 heigth=12 border=0 alt="" Hidden field : " & field.name & " "">" w "<input type=""hidden"" name=""fieldname"" value=""" & field.name & """>" w "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" w "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" w "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" w "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" w "<input type=""hidden"" name=""pagesize"" value=" & request("pagesize") & ">" w "</th></form>" end if next w "</tr>" '--- display records from the current record to the pagesize -------------------------------- if intTotalRecords > 0 Then for i = intCurrentRecord to RS.PageSize if not RS.EOF then '---alternate row color w "<tr " If (IE) then w " onMouseOver=""this.bgColor = '#CCCCCC'"" " End if If i Mod 2 = 0 Then w " onMouseOut=""this.bgColor = '" & rowColor1 & "'"" bgcolor=" & rowColor1 & ">" Else w " onMouseOut=""this.bgColor = '" & rowColor2 & "'"" bgcolor=" & rowColor2 & ">" End If '--- display ADD EDIT DELETE PRINT-------------------------------- If bEnableEdit Then If instr(strPrimaryKey, "desc") > 0 Then cPKSort = replace(strPrimaryKey, "desc", "") else cPKSort = strPrimaryKey If instr(strPrimaryKey, "asc") > 0 Then cPKSort = replace(strPrimaryKey, "asc", "") w "<td align=center " & strTDAttributes & " bgcolor=#D9D9D9>" w "<a href=""?table="& strDbTable &"&action=edit&member=" & RS(cPKSort) & "&url=" & GetFileName(Request.ServerVariables("URL")) &_ "&strdbsource=" & strdbsource & "&strdbtable=" & strdbtable & "&strdefaultsort=" & strDefaultSort & """ title="" MODIFICA RECORD "">" w "<b><img src=""" & strimgDir & "u_edit.gif"" width=13 height=13 border=0></b></a>" w "<a href=""?table="& strDbTable &"&action=delete&member=" & RS(cPKSort) & "&url=" & GetFileName(Request.ServerVariables("URL")) &_ "&strdbsource=" & strdbsource & "&strdbtable=" & strdbtable & "&strdefaultsort=" & strDefaultSort & """ title="" CANCELLA RECORD "">" w "<b><img src=""" & strimgDir & "u_delete.gif"" width=13 height=13 border=0></b></a>" If bShowPrint Then w "<a href=""" & strIncPath & "printrec.asp?dsn=" & Server.Urlencode(dsn) & "&primarykey=" & Replace(strDefaultSort, DefaultSort, "") & "&strdbtable=" & strdbtable & "&member=" & RS(cPKSort) & """ target=""_blank"">" w "<img src=""" & strimgDir & "print_1.gif"" name=""Stampa record"" border=""0"" height=""13"" width=""13"" title="" STAMPA RECORD ""></a>" End if w "</td>" End if '###### Show fields content ########### '---for each field in the recordset for each field in RS.Fields if field.name <> isPrimaryKey OR NOT bHideFirstColumn then if not isexcluded(field.type) then '--- toggle hidden field control If not Request.Cookies("hidefield")(field.name) then If field.type = adLongVarWChar then w "<td " & strTDAttributes & " width=300>" Else w "<td " & strTDAttributes & ">" End if If isNULL(field.value) Then w " " elseif field.type = adBoolean then if field.value = true then w "True" else w "False" End if else '--- replace <br> with VbCrLf in text fields w replace(field.value, CHR(13), "<br>") end if else w "<td " & strTDAttributes & "> " end if w "</td>" else '--- is an excluded field type '--- replace excluded binary data fields with image w "<td " & strTDAttributes & " align=center><img src=""" & strimgDir & "no.gif"" width=16 height=16 border=0 align=absmiddle alt="" Binary data field ""></td>" end if end if next '############################# w "</tr>" RS.MoveNext end if next else '--- no records w "<tr bgcolor=#F0F0F0><td " & strTDAttributes & " colspan=" & FieldsCount & ">" w "<div style='font-size:12px;'>Ricerca " If strKeyWords <> "" AND instr(1,strKeyWords," ",1) > 0 Then if TheMode = "OR" then w "(qualsiasi parola)" Else w "(tutte le parole)" End if End if w " risultato per: <b>" & strKeyWords & "</b> = <span style='color:#F00000;font-weight:bold;background-color:yellow;'> nessuna corrispondenza trovata </span></div></td></tr>" end if w "</table>" '--- bottom page navigation------------------------------------------ If LowerNav Then strFirstp = "<img src=""" & strimgDir & strimgFirstMoff & """ align=absmiddle border=1 alt=""" & strFirstpTitle & strPagep &""" name=""strimgFirstBottom"" style=""border-color:black;"">" strPrevp = "<img src=""" & strimgDir & strimgPrevMoff & """ align=absmiddle border=1 alt=""" & strPrevpTitle & "(" & strPagep & intCurrentPage - 1 & ")"" name=""strimgPrevBottom"" style=""border-color:black;"">" strNextp = "<img src=""" & strimgDir & strimgNextMoff & """ align=absmiddle border=1 alt=""" & strNextpTitle & "(" & strPagep & intCurrentPage + 1 & ")"" name=""strimgNextBottom"" style=""border-color:black;"">" strLastp = "<img src=""" & strimgDir & strimgLastMoff & """ align=absmiddle border=1 alt=""" & strLastpTitle & "(" & strPagep & intTotalPages & ")"" name=""strimgLastBottom"" style=""border-color:black;"">" '--- give links to move between pages strMoveFirst = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=1&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes &_ " title="" Vai alla prima pagina """ & _ " onMouseOver=""document.strimgFirstBottom.src='" & strimgDir & strimgFirstMon & "'""" & _ " onMouseOut=""document.strimgFirstBottom.src='" & strimgDir & strimgFirstMoff & "'"">" & _ strFirstp & "</A> " strMovePrevious = "<a href=" & strPageName & "?table="& strDbTable &"&sort=" & strSort & "&page=" & intCurrentPage - 1 & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strPrevpTitle & "(" & strPagep & intCurrentPage - 1 & ")""""" & _ " onMouseOver=""document.strimgPrevBottom.src='" & strimgDir & strimgPrevMon & "'""" & _ " onMouseOut=""document.strimgPrevBottom.src='" & strimgDir & strimgPrevMoff & "'"">" & _ strPrevp & "</A> " strMoveNext = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=" & intCurrentPage + 1 & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strNextpTitle & "(" & strPagep & intCurrentPage + 1 & ")""""" & _ " onMouseOver=""document.strimgNextBottom.src='" & strimgDir & strimgNextMon & "'""" & _ " onMouseOut=""document.strimgNextBottom.src='" & strimgDir & strimgNextMoff & "'"">" & _ strNextp & "</A>" strMoveLast = "<a href=" & strPageName & "?table="& strDbTable &"&sort="& strSort & "&page=" & intTotalPages & "&pagesize=" & intPageSize &_ "&strKeyWords=" & replace(strKeyWords, " ", "+") & "&mode=" & TheMode & " " & strTHAttributes & " title=""" & strLastpTitle & "(" & strPagep & intTotalPages & ")""""" & _ " onMouseOver=""document.strimgLastBottom.src='" & strimgDir & strimgLastMon & "'""" & _ " onMouseOut=""document.strimgLastBottom.src='" & strimgDir & strimgLastMoff & "'"">" & _ strLastp & "</A>" select case cint(intCurrentPage) '---if there is only one last page then no links case cint(intTotalPages) If cint(intTotalPages) = 1 Then strMoveFirst = "" strMovePrevious = "" strMoveNext = "" strMoveLast = "" '---if its the last page give only links to movefirst and move previous else strMoveNext = "" strMoveLast = "" end if '---if its the first page only give links to move next and move last case 1 strMoveFirst = "" strMovePrevious = "" case 2 strMoveFirst = "" case cint(intTotalPages - 1) strMoveLast = "" '---if its a page in the middle give all links case else end select with Response .Write "<table width='100%' border=0 cellpadding=0 cellspacing=0><tr><th " & strTHAttributes & ">" .Write "<table border=0 cellpadding=0 cellspacing=0 align=left>" .Write "<form action="""" method=""post"" name=""frmPage"">" .Write "<tr><th " & strTHAttributes & " align=left vAlign=middle> " .Write strMoveFirst & " " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write strMovePrevious .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write " <span style=""font-weight:normal;""> Page:</span> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" '--- select page # if intTotalPages > 1 then .Write "<input type=""hidden"" name=""frmOrderBy"" value=" & strSort & ">" .Write "<input type=""hidden"" name=""frmRecordsPerPage"" value=" & intPageSize & ">" .Write "<input type=""hidden"" name=""frmKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" .Write "<input type=""hidden"" name=""frmMode"" value=" & TheMode & ">" .Write "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" .Write " <select name=""PageNbr"" onchange=""SelectPageBottom()"">" for i = 1 to intTotalPages if CStr(i) = CStr(intCurrentPage) Then sele = " selected style=""color:#F00000;""" Else sele = " style=""color:black;""" End if .Write "<option value=" & CStr(i) & sele & "> " & CStr(i) & " </option>" next .Write "</select> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle style=""font-weight:normal;"">" .Write "of " & intTotalPages & " " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write strMoveNext & " " .Write strMoveLast Else '--- there is only one page .Write " 1 " End if .Write "</th></form>" '--- select records per page .Write "</th></form><form action="""" method=""post"" name=""frmRPP""><th " & strTHAttributes & " align=left vAlign=middle>" .Write " - <span style=""font-weight:normal;"">Records/Pagina:</span> " .Write "</th><th " & strTHAttributes & " align=left vAlign=middle>" .Write "<input type=""hidden"" name=""fKeyWords"" value=""" & replace(strKeyWords, " ", "+") & """>" .Write "<input type=""hidden"" name=""fOrderBy"" value=""" & strSort & """>" .Write "<input type=""hidden"" name=""fMode"" value=" & TheMode & ">" .Write "<input type=""hidden"" name=""Table"" value=" & strDbTable & ">" .Write "<select name=""RPP"" class=""inputbox"" onchange=""SelectRecordsPerPageBottom()"">" If intTotalRecords > 10 Then If intPageSize = 10 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""10""" & sele1 & "> 10 </option>" End if If intTotalRecords > 25 Then If intPageSize = 25 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""25""" & sele1 & "> 25 </option>" End if If intTotalRecords > 50 Then If intPageSize = 50 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""50""" & sele1 & "> 50 </option>" End if If intPageSize <> 10 AND intPageSize <> 25 AND intPageSize <> 50 then sele1 = " SELECTED style=""color:#F00000;""" else sele1 = " style=""color:black;""" End if .Write "<option value=""all""" & sele1 & "> TUTTI </option>" .Write "</select>" .Write "</th></form><th " & strTHAttributes & " align=left vAlign=middle>" If Cint(intPageSize) > 1 Then .Write " <span style=""font-weight:normal;""> - ( Records <b>" & intStart &_ "</b> di <b>" & intFinish & "</b> di <b>" & intTotalRecords & "</b> totali )</span>" End if .Write "</th></tr></table></td></tr></table>" End With End if if RS.State = &H00000001 then '---its open RS.Close set RS = nothing set objConn = nothing end if '--- Search Box ---------------------------------------------- With Response .Write "<span style=""font-size:1px;""> </span>" .Write "<table border=0 CellSpacing=2 CellPadding=0 style='border:solid 1px #999999;'>" '--- Frame description ------------------ If Description Then .Write "<tr><td bgcolor=#FFFFFF " & strTRAttributes & " colspan=9 align=center vAlign=top>" If Cint(intPageSize) > 1 Then if instr(strSort, "desc") then Sorting = "<b>" & Replace(strSort, "desc", "") & "</b> Decrescente" Else Sorting = "<b>" & strSort & "</b> Crescente" End if If intPageSize = intTotalRecords Then Rpp = "All" Else Rpp = intPageSize End if .Write "<span style=""font-weight:normal;"" align=center>" .Write " ( Pagine Totali: <b>" & intTotalPages & "</b> - visualizza i record <b>" & intStart & "</b> di <b>" & intFinish &_ "</b> di <b>" & intTotalRecords & "</b> " .Write " - Records/Pagina: <b>" & Rpp & "</b> - Ordina campo: " & Sorting & " )</span> " .Write " </td></tr>" If SearchBox AND Description Then .write "<tr style=""border-bottom: 1px solid #999999;""><td bgcolor=#999999 colspan=9></td></tr>" End if End if If SearchBox Then .Write "<tr " & strTRAttributes & "><FORM name=frmSearch action="""" method=GET>" .Write "<td " & strTRAttributes & " align=right> <b>Ricerca</b> parola(e): </td>" .Write "<td><INPUT onFocus=clearfield() type=text name=strKeyWords value=""" & request("strKeyWords") & """ class=tflat size=20>" & msg & "</td>" .Write "<td " & strTRAttributes & "><INPUT type=submit value='RICERCA' style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:60;""" .Write " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" .Write " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""" .Write " NAME='button' TITLE=' Ricerca parole in archivio '></td>" .Write "<td " & strTRAttributes & "> <input type=radio name=mode value=OR" if Themode = "" OR TheMode = "OR" Then .write " CONTROLLATI" End if .write " style=""cursor:hand;""></td><td " & strTRAttributes & ">Ogni parola " .Write "</td><td " & strTRAttributes & "><input type=radio name=mode value=AND" if Themode = "AND" Then .write " Controllati" End if .Write " style=""cursor:hand;""></td><td " & strTRAttributes & ">Tutte le parole </td>" .write "<input type=""hidden"" name=""table"" value=""" & strDbTable & """></FORM>" .Write "<form method=""post""><td " & strTRAttributes & ">" .write "<input type=""hidden"" name=""table"" value=""" & strDbTable & """>" .Write "<INPUT TYPE=submit style=""color:#black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;"" " .Write " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" .Write " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""" .Write " VALUE="" SQL "" TITLE="" Toggle SQL debugging window "">" .write "<input type=""hidden"" name=""dSQL"" value=""SQL"">" .Write " </td></form>" .Write "</tr>" if strKeyWords <> "" and not bnorec then '--- show search result and words find ------------- .Write "<tr><td bgcolor=#999999 colspan=9></td></tr>" .Write "<form action="""" id=""f"" onsubmit=""return hi(this);"" name=frmFind>" .Write "<tr " & strTRAttributes & "><td nowrap " & strTRAttributes & " align=right>" .Write " <b>Cerca</b> in questa pagina: </td><td " & strTRAttributes & ">" .Write "<input onFocus=clearfieldfind() name='q' type='text' class='tflat' value=""" & request("strKeyWords") & """ style=""font-weight:bold;"" size=20></td>" .Write "<td " & strTRAttributes & "><INPUT type=submit value='CERCA' style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:60;""" .Write " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" .Write " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""" .Write " NAME='find' TITLE=' Trova le parole in questa pagina ' ACCESSKEY=""s""></td>" .Write "<td " & strTRAttributes & " align=center valign=middle>" .Write "<input type='radio' id='phrase' name='phrase'>" .Write "</td><td " & strTRAttributes & ">Frase</td>" .Write "<td " & strTRAttributes & ">" .Write "<input type='radio' id='cases' name='cases'>" .Write "</td><td " & strTRAttributes & ">MAIUSCOLO-minuscolo " .Write "<input type='hidden' id='regex' name='regex' checked>" .Write "</td></FORM></tr>" End if End if .write "</table>" '---- Debug SQL ------- If DebugSQL Then ' .Write "<span style=""font-size:1px;""> </span>" ' .Write "<table border=0 cellspacing=0 cellpadding=3 style=""border: 1 black solid;"" style='font-family:Verdana;font-size:7pt;color:NAVY;'><tr><td vAlign=top>" ' .Write "<b>SQL Command:</b> """ & strSQLString & """" ' .Write "</td></tr></table>" '---- mystrSQL --------------------------------- Dim strSQLTemp strSQLTemp = Trim(replace(strSQLString, "SELECT * FROM " & strdbTable & "", "")) If len(strSQLTemp) = 0 Then strSQLTemp = request.querystring("mystrSQL") .Write "<span style=""font-size:1px;""> </span>" .Write "<table border=0 CellSpacing=2 CellPadding=0 style='border:solid 1px #999999;'>" .Write "<tr " & strTRAttributes & "><FORM name=mySQLstring action="""" method=GET>" .Write "<td " & strTRAttributes & " nowrap valign=top align=right colspan=2> <b style=""color:crimson;"">SELECT * FROM " & strdbTable & " </b><br>" .Write "</td><td rowspan=3><textarea name=mystrSQL class=tflat cols=90 rows=6>" & strSQLTemp & "</textarea></td></tr>" .Write "<tr><td colspan=2 " & strTRAttributes & " align=right>Enter or modify <br>the <b>SQL</b> query: <br></td></tr>" .Write "<tr><td align=right valign=top style=""padding-top:2px;""> " .Write "<a href=""" & strPageName & "?table="& strDbTable &"&fieldSQL=reset"" style=""color:"&sResetColor&";font-weight:bold;text-decoration:none;background-color:"&sResetBGColor&";CURSOR:HAND;border:solid 1px navy;WIDTH:43;padding-top:1px;padding-bottom:2px;""" .Write " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" .Write " onMouseout=""this.style.color='"&sResetColor&"'; this.style.background='"&sResetBGColor&"'; return true;""" .Write " title="" AZZERA FILTRI E QUERY ""> RESET </a>" .Write "</td><td valign=top align=right " & strTRAttributes & ">" .Write "<INPUT type=submit value='QUERY' style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:43;""" .Write " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" .Write " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""" .Write " NAME='button' TITLE=' Invia la tua Query '> " .Write "</td><input type=""hidden"" name=""table"" value=""" & strDbTable & """></FORM></tr></table>" End if .Write "</td></tr></table>" end with End function '---------------------------------------------------------------------- Sub dbedit() W "<Style type=""text/css"">" W "<!--" W "TR, TD {Font-family:Verdana;font-weight:normal;font-size:10px;color:black;}" W "select {font-family:Verdana, Tahoma;font-size:10px;color:#000066;border-style:solid;border-color:#0066CC;background-color: #E0E0E0;}" W "input {font-family:Verdana, Tahoma;font-size:10px;color:#000066;padding-left:3px;padding-right:3px;}" W "textarea {font-family:Verdana, Tahoma;font-size:10px;color:#000066;padding-left:3px;padding-right:3px;}" W "//-->" W "</style>" ' ----- Remember the referer page --- If len(Request.QueryString("url")) > 0 Then Session("referer") = Session("basereferer") & "?table=" & Request.QueryString("table") End if If len(Request.QueryString("strdbtable")) > 0 Then Session("TABLE") = Request.QueryString("strdbtable") End if If len(Request.QueryString("strdbsource")) > 0 Then Session("Source") = Request.QueryString("strdbsource") End if If len(Request.QueryString("strDefaultSort")) > 0 Then Session("PRIMARYKEY") = Replace(Request.QueryString("strDefaultSort"), DefaultSort, "") End if Set objRS = Server.CreateObject("ADODB.Recordset") w "<TABLE cellSpacing=0 cellPadding=4 border=0 align=center style='border:solid 1px #999999;' bgcolor=white><TBODY><TR><td vAlign=top>" w "<table border=0 cellpadding=0 cellspacing=0 align=center><tr><td>" Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open dsn Select Case Request.QueryString("action") Case "edit" Session("queryS") = Request.Querystring w "<div style=""background-color:yellow;"">" & Session("msg") & "</div>" Call EditField () Case "add" Session("queryS") = Request.Querystring w "<div style=""background-color:yellow;"">" & Session("msg") & "</div>" Call AddField () Case "delete" Session("queryS") = Request.Querystring w "<div style=""background-color:yellow;"">" & Session("msg") & "</div>" Call DeleteField () Case "exe" If Request.QueryString("do") = "doedit" Then Call DoEdit () ElseIf Request.QueryString("do") = "doadd" Then Call DoAdd () ElseIf Request.QueryString("do") = "dodelete" Then Call DoDelete () End if End Select objConn.Close Set objConn = Nothing w "</td></tr></table>" w "</td></tr></table>" End sub ''---------------------------------------------------------------------- Sub EditField () Dim cspan, varformnum, strname Dim FieldCounter, field, bgcolor Dim bSelTrue, bSelFalse SQL2 = "SELECT * FROM " & Session("TABLE") & " WHERE " & Session("PRIMARYKEY") & " LIKE ('%" & request.querystring("member") & "%')" objRS.Open SQL2, objConn, 1, 3 w "<table border=0 cellpadding=4 cellspacing=0 align=center>" if Request("sft") = "ok" Then If Session("bShowFieldType") = False Then Session("bShowFieldType") = True else Session("bShowFieldType") = False end if If ISNULL(Session("bShowFieldType")) Then Session("bShowFieldType") = bShowFieldType else bShowFieldType = Session("bShowFieldType") end if end if If Session("bShowFieldType") then cspan = 4 else cspan=2 w "<FORM name=""frmShowFieldType"" action=""?"&Request.querystring&""" method=POST>" w "<tr bgcolor=white><td colspan=" & cspan & " align=center><b>Modifica record nella tabella: """ & Session("TABLE") & """</b>" w "<input type=""image"" src=""" & strimgDir & "definition.gif"" height=""14"" width=""15"" align=""absmiddle"" alt=""Alterna campo di definizione visualizzazione "" border=0 style=""border:none;cursor:hand;"" value=""ok"" onClick=""this.form.submit();"">" w "<input type=""hidden"" name=""sft"" value=""ok"">" w "</td></tr>" w "</form>" w "<form action=""" & Request.Servervariables("SCRIPT_NAME") & "?action=exe&do=doedit"" Method=""Post"" name=""doEditField"">" FieldCounter = 1 For Each field in objRS.Fields bgcolor = "#E0E0E0" If FieldCounter Mod 2 = 0 Then bgcolor = "#F0F0F0" If Instr(Session("msg"), field.name) > 0 Then bgcolor = "#FF0000" w "<TR bgcolor=" & bgcolor & "><TD align=right><b>" & Trim(GetColDescription(field.name)) & "</b> </TD><TD>" If Session("bShowFieldType") then w GetTypeString(field.type) & " </TD><TD>" w GetAttributesString(field.type) & " </TD><TD>" End if strname = field.name varformnum = "1" If NOT IsPrimaryKey_inDBSchema(field.name, Session("TABLE")) Then if IsExcluded(field.type) OR field.name = Session("PRIMARYKEY") then if field.type = adLongVarBinary then w "<img src=""" & strimgDir & "no.gif"" width=16 height=16 border=0 align=absmiddle alt="" Ccampo dati Binario"">" else w Trim(objRS(field.name)) end if else if (field.type = adLongVarChar) or (field.type = adLongVarWChar) then ' MEMO -> TEXTAREA w "<textarea name=""" & field.name & """ cols=60 rows=5>" & objRS(field.name) & "</textarea>" w " <a href=""#"" onclick=""javascript:window.open('" & strIncPath & "ZoomText.asp?CallingForm=" & varformnum & "&TextField=" & server.urlencode(strName) & _ "', 'zoomtext','height=400,width=600,scrollbars=yes,resizable=yes');return false""><img alt="" Expand and edit text "" SRC=""" & strIncPath & "images/u_Edit.gif"" border=0 width=13 height=13></a>" elseif (field.type = adBoolean) then ' -> COMBO bSelTrue = "" bSelFalse = "" if field.value = true then bSelTrue = " selected" else bSelFalse = " selected" end if w "<select name=""" & field.name & """ class=inputbox>" w "<option" & bSelTrue & ">" & CStr(True) w "<option" & bSelFalse & ">" & CStr(False) w "</select>" else ' -> INPUT w "<input type=""text"" name=""" & field.name & """ class=inputbox maxlength=255 size=60 value=""" & objRS(field.name) & """>" end if end if Else w "<input type=""hidden"" name=""Member"" value=""" & objRS(field.name) & """>" w Trim(objRS(field.name)) End if If Instr(Session("msg"), field.name) > 0 Then w "</td></tr><TR bgcolor=" & bgcolor & "><TD colspan=2 style=""background-color:#ffffff;border: solid 2px red;"">" & Session("msg") w "</TD></TR>" FieldCounter = FieldCounter + 1 Next w "<tr bgcolor=white><td align=center colspan=" & cspan & " valign=middle>" w "<input type=""submit"" name=""Submit"" value="" Aggiorna Record "" style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:120;""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;"">" w " <a href="""&Session("referer")&""" style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""> Esci </a>" w "</td></tr></form></table>" objRS.Close Set objRS = Nothing End Sub '-- EditField ''---------------------------------------------------------------------- Sub DoEdit () objRS.Open Session("TABLE"), objConn, 1, 3 if instr(Request.Form("Member"), ",") > 0 then w "La Tabella: " & Session("PRIMARYKEY") & " ha più di una chiave primaria, non può essere modificato <br>" w "<div align=center><INPUT TYPE=BUTTON class=""button"" "& _ "onClick=""location.href='"&Session("referer")&"'"" "& _ "NAME=""button1"" VALUE="" Exit "" TITLE="" Esci ""></div>" exit sub end if On error resume next objRS.Find Session("PRIMARYKEY") & "='" & Request.Form("Member") & "'" Call ExecFieldUpdate () objRS.Update If Err.number <> 0 Then Session("msg") = "<b style=""color:red;font-size:12px;""> ERROR</b> : " & Err.description Else Session("msg") = "<b style=""color:red;font-size:12px;""> Record N." & Request.Form("member") & " è stato aggiornato. </b>" End if objRS.Close Set objRS = Nothing If Err.number <> 0 Then Response.redirect Request.Servervariables("SCRIPT_NAME") & "?" & Session("queryS") Else Response.redirect Session("referer") End if On error goto 0 End Sub '--- Doedit ''---------------------------------------------------------------------- Sub AddField () Dim varformnum, strname, cspan Dim FieldCounter, field, bgcolor, UCfield Dim bSelTrue, bSelFalse SQL2 = "SELECT * FROM " & Session("TABLE") objRS.Open SQL2, objConn, 1, 3 w "<table border=0 cellpadding=4 cellspacing=0 align=center>" If bShowFieldType then cspan = 4 else cspan=2 if Request("sft") = "ok" Then If Session("bShowFieldType") = False Then Session("bShowFieldType") = True else Session("bShowFieldType") = False end if If ISNULL(Session("bShowFieldType")) Then Session("bShowFieldType") = bShowFieldType else bShowFieldType = Session("bShowFieldType") end if end if If Session("bShowFieldType") then cspan = 4 else cspan=2 w "<FORM name=""frmShowFieldType"" action=""?"&Request.querystring&""" method=POST>" w "<tr bgcolor=white><td colspan=" & cspan & " align=center><b>Aggiungi record nella tabella: """ & Session("TABLE") & """</b>" w "<input type=""image"" src=""" & strimgDir & "definition.gif"" height=""14"" width=""15"" align=""absmiddle"" alt="" Alterna campo di definizione visualizzazione "" border=0 style=""border:none;cursor:hand;"" value=""ok"" onClick=""this.form.submit();"">" w "<input type=""hidden"" name=""sft"" value=""ok"">" W "</td></tr>" w "</form>" w "<form action=""" & Request.Servervariables("SCRIPT_NAME") & "?action=exe&do=doadd"" Method=""Post"">" FieldCounter = 1 If NOT objRS.EOF Then objRS.movelast For Each field in objRS.Fields bgcolor = "#E0E0E0" If FieldCounter Mod 2 = 0 Then bgcolor = "#F0F0F0" If Instr(Session("msg"), field.name) > 0 Then bgcolor = "#FF0000" w "<TR bgcolor=" & bgcolor & "><TD align=right><b>" & Trim(GetColDescription(field.name)) & "</b> </TD><TD>" If bShowFieldType then w GetTypeString(field.type) & " </TD><TD>" w GetAttributesString(field.type) & " </TD><TD>" End if strname = field.name varformnum = "1" if IsExcluded(field.type) OR field.name = Session("PRIMARYKEY") then if (field.type = adLongVarWChar) then w Trim(objRS(field.name)) + 1 end if else if (field.type = adLongVarChar) or (field.type = adLongVarWChar) then ' -> MEMO -> TEXTAREA w "<textarea name=""" & field.name & """ cols=60 rows=5></textarea>" w " <a href=""#"" onclick=""javascript:window.open('" & strIncPath & "ZoomText.asp?CallingForm=" & varformnum & "&TextField=" & server.urlencode(strName) & _ "', 'zoomtext','height=400,width=600,scrollbars=yes');return false""><img alt="" Espandere e modificare il testo "" SRC=""" & strIncPath & "images/u_Edit.gif"" border=0 width=13 height=13></a>" elseif (field.type = adBoolean) then ' -> COMBO w "<select name=""" & field.name & """ class=inputbox>" w "<option" & bSelFalse & ">" & CStr(False) w "<option" & bSelTrue & ">" & CStr(True) w "</select>" else ' -> INPUT w "<input type=""text"" name=""" & field.name & """ class=inputbox maxlength=255 size=60>" end if end if If Instr(Session("msg"), field.name) > 0 Then w "</td></tr><TR bgcolor=" & bgcolor & "><TD colspan=2 style=""background-color:#ffffff;border: solid 2px red;"">" & Session("msg") w "</TD></TR>" FieldCounter = FieldCounter + 1 Next w "<tr bgcolor=white><td align=center colspan=" & cspan & " valign=middle>" w "<input type=""submit"" name=""Submit"" value="" Aggiungi Record "" style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:120;""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;"">" w " <a href="""&Session("referer")&""" style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;""> Esci </a>" w "</td></tr></form></table>" objRS.Close Set objRS = Nothing End Sub '--- Addfield ''---------------------------------------------------------------------- Sub DoAdd () On error resume next SQL2 = "SELECT * FROM " & Session("TABLE") objRS.Open SQL2, objConn, 1, 3 objRS.AddNew Call ExecFieldUpdate () objRS.Update If Err.number <> 0 Then Session("msg") = "<b style=""color:red;font-size:12px;"">ERRORE</b> : " & Err.description Else Session("msg") = "<b style=""color:red;font-size:12px;"">Il record è stato aggiunto.</b>" End if objRS.Close Set objRS = Nothing If Err.number <> 0 Then Response.redirect Request.Servervariables("SCRIPT_NAME") & "?" & Session("queryS") Else Response.redirect Session("referer") End if On error goto 0 End Sub '--- DoAdd ''---------------------------------------------------------------------- Sub DeleteField () Dim Field SQL2 = "SELECT * FROM " & Session("TABLE") & " WHERE " & Session("PRIMARYKEY") & " LIKE ('%" & request.querystring("member") & "%')" objRS.Open SQL2, objConn, 1, 3 w "<table border=0 cellpadding=2 cellspacing=0 align=center bgcolor=white><tr><td width=""100%"" align=center><br>" w "Sei sicuro di voler cancellare questo record # <b>" & objRS(Session("PRIMARYKEY")) & "</b> ?<br><p>" w "<table border=0 cellpadding=2 cellspacing=1 align=center bgcolor=#FFFFFF style='border:solid 1px #999999;'><tr>" For each Field in objRS.Fields w "<td align=center bgcolor=#385C8E><b style=""color:white;"">" & GetColDescription(field.name) & "</b></td>" Next w "</tr><tr>" For each Field in objRS.Fields if NOT IsExcluded(field.type) then w "<td align=center bgcolor=#E0E0E0>" & Field & "</td>" else if field.type = adLongVarBinary then w "<td align=center bgcolor=#E0E0E0><img src=""" & strimgDir & "no.gif"" width=16 height=16 border=0 align=absmiddle alt="" Campo dati Binario ""></td>" else w "<td align=center bgcolor=#E0E0E0> </td>" end if end if Next w "</tr></table><br>" w "<a href=""" & Request.Servervariables("SCRIPT_NAME") & "?action=exe&do=dodelete&member=" & objRS(Session("PRIMARYKEY")) & """ style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:120;padding-bottom:1px;padding-top:1px""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;"">" W "<b> Cancello ! </b></a> " w "<a href="""&Session("referer")&""" style=""color:black;font-weight:bold;text-decoration:none;background-color:#D1E0FD;border: solid 1px navy;CURSOR:HAND;WIDTH:60;padding-top:1px;padding-bottom:1px;""" W " onMouseover=""this.style.color='#4D6185'; this.style.background='#DCECFD'; return true;""" W " onMouseout=""this.style.color='black'; this.style.background='#D1E0FD'; return true;"">" W " Esci </a><br>" w "</font></td></tr></table>" objRS.Close Set objRS = Nothing End Sub '--- DeleteField ''---------------------------------------------------------------------- Sub DoDelete () On error resume next SQL2 = "DELETE FROM " & Session("TABLE") & " WHERE " & Session("PRIMARYKEY") & " LIKE ('%" & request.querystring("member") & "%')" Set objRS = objConn.Execute(SQL2) If Err.number <> 0 Then Session("msg") = "<b style=""color:red;font-size:12px;"">ERRORE</b> : " & Err.description Response.redirect Request.Servervariables("SCRIPT_NAME") & "?" & Session("queryS") Else Session("msg") = "<b style=""color:red;font-size:12px;"">Il Record è stato rimosso.</b>" Response.redirect Session("referer") End if On error goto 0 End Sub '--- DoDelete ''---------------------------------------------------------------------- Private Sub ExecFieldUpdate () On error resume next Dim Field, Item For each Field in Request.Form For each Item in objRS.Fields If lcase(Item.name) = lcase(Field) Then Select Case Item.Type Case 3 '"adInteger" If isnumeric(request.form(Field)) then objRS.Fields(Field) = Int(request.form(Field)) Else objRS.Fields(Field) = 0 End if Case 11 '"adBoolean" objRS.Fields(Field) = CBool(request.form(Field)) Case 7, 133 '"adDate", "adDBDate" If IsDate(Request.Form(Field)) Then objRS.Fields(Field) = dataDB(request.form(Field)) End if Case Else objRS.Fields(Field) = Request.Form(Field) End Select End if Next Next If Err.number <> 0 Then Session("msg") = "<b style=""color:red;font-size:12px;"">ERRORE</b> : " & Err.description End if End Sub '--- ExecFieldUpdate ''---------------------------------------------------------------------- Private Function IsPrimaryKey_inDBSchema ( sField , sTable ) '' Checks if the given field is defined in db schema Dim bReturn bReturn = False Dim rsSchema Set rsSchema = Server.CreateObject("ADODB.Recordset") rsSchema.CursorType = 2 'adOpenDynamic Set rsSchema = objConn.openSchema(12) '(adSchemaIndexes) do while (not rsSchema.EOF) and (not bReturn) if LCase(rsSchema("TABLE_NAME")) = LCase(sTable) then if LCase(rsSchema("COLUMN_NAME")) = LCase(sField) then if rsSchema("PRIMARY_KEY") then bReturn = True end if end if end if rsSchema.MoveNext loop rsSchema.Close Set rsSchema = Nothing IsPrimaryKey_inDBSchema = bReturn End Function '--- IsPrimaryKey_inDBSchema ''---------------------------------------------------------------------- Private Function dataDB(varDate) Dim myYear Dim myDay Dim myMonth vardate=CDate(varDate) myYear = Year(varDate) myDay = Day(varDate) myMonth = Month(varDate) datadb = myYear & "/"& myMonth & "/" & myday End Function '--- dataDB '-------------------------------------------------------------------- %>
[
Íàçàä
]