<%response.buffer = true %> <% function rw(str) Response.Write str end function 'Copyright 2001,2002 Bill & Sara Newman, http://www.newmanic.com/ 'Authorized for use on SSCC Web Page Generator only 'Version 19 Const myTable = "Students" Const myKey = "StudentID" Const myTrueWord = "True" Const myPage = 30 Const myTitle = "Class Editor" Const myExit = "http://www.billnsara.com/cis212/default.asp" Const myTextLength = 30 Const thisPage = "class.asp" '*** dim myOrder dim sh, tp dim fullntfy,shhidestring,shkey shhidestring = "itc280editSHString" shkey = "itc280editSHKey" Const myWhere = " where Status = 'Current' " Const myStyle = "editor.css" Const myStripes = "#cbcbcb" Const myDates = 0 Const myDebug = True '*** Const adUseClient = 3 Const adOpenForwardOnly = 0 Const adLockBatchOptimistic = 4 Const myVersion = "1.11" Dim objConn, column Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open connstring strMyOwnPath = Request.Servervariables("PATH_INFO") intStart = InstrRev(strMyOwnPath,"/",-1,1) strMyName = Mid(strMyOwnPath,intStart+1) strAction = Request.Querystring("action") lngRecord = Request.Querystring("num") lngPage = Request.Querystring("page") column = Request.Querystring("column") ascend = Request.Querystring("asc") shHide = Request.Form("showhide") If lngPage = "" Then lngPage = 1 lngPage = CLng(lngPage) '*** If myDebug then rw "" & vbCrLf End If '*** Select Case strAction Case "list" Call editList() Case "update" Call editUpdate(lngRecord) Case "updateExec" Call editUpdateExec(lngRecord) Case "insert" Call editInsert() Case "insertExec" Call editInsertExec() Case "deleteExec" dim temp,count,x for x = 1 to request.form("Delete").Count temp = request.form("Delete")(x) Call editDeleteExec(temp) next column = "" ascend = "" page = lngPage Call editList(column,ascend,page) Case "shhd" dim tmp1,g,strFields for g = 1 to request.form("add").Count if strFields = "" then strFields = request.form("add")(g) else strFields = strFields & "," & request.form("add")(g) end if next Application(shhidestring) = strFields Application(shkey) = shHide column = "" ascend = "" page = 0 Call editList(column,ascend,page) Case "showFields" Call fieldPreferences(lngRecord) Case "exitPage" Call exitPage() Case "orderBy" Call orderBy(column,lngPage,ascend) Case Else column = "" ascend = "" page = 0 Call editList(column,ascend,page) End Select '*** Function clearType (intType) Select Case intType Case 2 strFieldType = "Integer" Case 3 strFieldType = "Long Integer" Case 4 strFieldType = "Single" Case 5 strFieldType = "Double" Case 6 strFieldType = "Currency" Case 7 strFieldType = "Date/Time" Case 11 strFieldType = "True/False" Case 17 strFieldType = "Byte" Case 7 strFieldType = "Date/Time" Case Else strFieldType = "Text" End Select clearType = strFieldType End Function '*** Function editUpdate(lngRecord) sqlQuery = "SELECT * FROM " & myTable & " WHERE " & myKey & "=" & lngRecord Set objRS = objConn.Execute(sqlQuery) intFieldCount = objRS.Fields.Count - 1 rw "" & myTitle & "" If Trim(myStyle & "") <> "" Then rw "" End If rw "" rw "

Update Record

" rw "
" rw "" For i = 0 To intFieldCount strName = objRS(i).Name strValue = objRS(i).Value If strName = myKey Then rw "" else strLength = Len(strValue) if isNull(strValue) then strValue = " " end if intType = objRS(i).Type rw "" If intType = 11 Then If strValue = True Then rw "" end if Next rw "
"& strValue & "
" & strName & ":True False" Else rw "True False" End if End If strValueLength = len(strValue) If intType <> 11 and strName <> myKey and strValueLength < 19 then rw " (" & clearType(intType) & ")" End If If intType <> 11 and strName <> myKey and strValueLength >= 19 then rownumber =(round(.03*(CInt(strValueLength))) + 1) rw "(" & clearType(intType) & ")" End If rw "

 

" rw "

 

" Set objRS = Nothing End Function '*** Function editUpdateExec(lngRecord) sqlQuery = "SELECT * FROM " & myTable & " WHERE " & myKey & "=" & lngRecord Set objRS = Server.CreateObject("ADODB.Recordset") objRS.Open sqlQuery, objConn, 1, 2 intFieldCount = objRS.Fields.Count - 1 For i = 0 To intFieldCount strName = objRS(i).Name intType = objRS(i).Type strNewValue = Request.Form(strName) testField = "~" & strName testField = Request.Form(testField) if testField <> strNewValue then If strName <> myKey Then Select Case intType Case 2, 3, 4, 5, 6, 17 If not IsNumeric(strNewValue) Then strNewValue = Null Case 11 If strNewValue = myTrueWord Then strNewValue = True Else strNewValue = False End If Case 7, 135 If not IsDate(strNewValue) Then strNewValue = Null Case Else If Trim(strNewValue) & "" = "" Then strNewValue = Null End Select objRS(strName) = strNewValue End If end if Next objRS.Update objRS.Close Set objRS = Nothing 'Call fullnotify(fullntfy) column = "" ascend = "" page = 0 Call editList(column,ascend,page) End Function '*** Function editInsert() rw "" & myTitle & "" If Trim(myStyle & "") <> "" Then rw "" End If rw "" rw "

Create Record

" rw "
" rw "" Set objRS = Server.CreateObject("ADODB.Recordset") objRS.Open myTable, objConn, 1, 2 intFieldCount = objRS.Fields.Count - 1 For i = 0 To intFieldCount strName = objRS(i).Name intType = objRS(i).Type If strName <> myKey Then rw "" If intType = 11 Then If strValue = True Then rw "" Else rw "" End if Else rw "" End If End If Next rw "
" & strName & "True False
True False
(" & clearType(intType) & ")

 

" rw "

 

" objRS.Close Set objRS = Nothing End Function '*** Function editInsertExec() Set objRS = Server.CreateObject("ADODB.Recordset") objRS.Open myTable, objConn, 1, 2 intFieldCount = objRS.Fields.Count - 1 objRS.AddNew For i = 0 To intFieldCount strName = objRS(i).Name intType = objRS(i).Type strNewValue = trim(Request.Form(strName)) If strName <> myKey Then if strNewValue <> "" then Select Case intType Case 2, 3, 4, 5, 6, 17 If not IsNumeric(strNewValue) Then strNewValue = Null Case 11 If Trim(strNewValue & "") = "" Then strNewValue = False Else If strNewValue = myTrueWord Then strNewValue = True Else strNewValue = False End If End If Case 7, 135 If not IsDate(strNewValue) Then strNewValue = Null Case Else If Trim(strNewValue) & "" = "" Then strNewValue = Null End Select objRS(strName) = strNewValue end if End If Next Response.Write "Outside the loop" objRS.Update Response.Write "After the Update" objRS.Close Set objRS = Nothing 'Call fullnotify(fullntfy) column = "" ascend = "" page = lngPage Response.Redirect thisPage End Function '*** Function editDeleteExec(lngRecord) objConn.Execute("DELETE * FROM " & myTable & " WHERE " & myKey & "=" & lngRecord) 'Call fullnotify(fullntfy) End Function '** Function editList(column,ascend,page) dim blnHide, blnHide2, b, c, hideArray, y sh = Application(shkey) tp = Application(shhidestring) hideArray = Split(tp,",") if sh = "" then sh = 0 end if sqlQuery = "SELECT * FROM " & myTable If Trim(myWhere & "") <> "" Then sqlQuery = sqlQuery & " " & myWhere If Trim(myOrder & "") <> "" Then sqlQuery = sqlQuery & " " & myOrder Set objRS = Server.CreateObject("ADODB.Recordset") objRS.CursorLocation = adUseClient objRS.Open sqlQuery, objConn, adOpenForwardOnly, adLockBatchOptimistic objRS.PageSize = myPage intFieldCount = objRS.Fields.Count - 1 If clng(lngPage) > objRS.PageCount Then lngPage = objRS.PageCount rw "No records in this table. Click new to add record." end if rw "" & myTitle & "" If Trim(myStyle & "") <> "" Then rw "" End If if page >= 1 then lngPage = page end if rw "" & vbCrLf rw "

" & myTitle & "

" & vbCrLf lngMaxPages = objRS.PageCount '*** If myDebug Then rw "" & vbCrLf End If '*** rw "

Page " & lngPage & " of " & lngMaxPages & "   " rw " First  " If lngPage = 1 Then lngPrevNext = 1 Else lngPrevNext = lngPage - 1 rw " Previous  " If lngPage = lngMaxPages Then lngPrevNext = lngMaxPages Else lngPrevNext = lngPage + 1 rw " Next  " rw " Last  " rw "   Refresh  " rw "   AddNew " rw "   Show/Hide    " rw "   Exit

" rw "" rw "" rw "" rw "" 'bn For i = 0 To intFieldCount blnHide = 0 for b = LBound(hideArray) to UBound(hideArray) if objRs(i).Name = hideArray(b) then blnHide = 1 c = c + 1 end if next blnHide = blnHide + sh if blnHide <> 1 or objRs(i).Name = myKey then If objRS(i).Type > 7 then rw "" else rw "" & objRs(i).Name & "" end if end if Next rw "" & vbCrLf If objRS.EOF Then rw "" Else intCounter = 0 if lngPage = 0 then objRS.AbsolutePage = 1 else objRS.AbsolutePage = lngPage end if For intPager = 1 to myPage intCounter = intCounter + 1 rw " "" Then If intCounter Mod 2 <> 0 Then rw " bgcolor=" & myStripes End If End If rw ">" rw vbCrLf & "" & vbCrLf end if Next rw "" & vbCrLf objRS.Movenext If objRS.EOF Then Exit For Next End If rw "
Command
" Else rw "" End If if column = objRs(i).Name then rw "" & objRs(i).Name & "
New
Edit  " rw "Delete" For i = 0 To intFieldCount blnHide2 = 0 for y = LBound(hideArray) to UBound(hideArray) if objRs(i).Name = hideArray(y) then blnHide2 = 1 end if next blnHide2 = blnHide2 + sh if blnHide2 <> 1 or objRs(i).Name = myKey then varFieldValue = objRS(i) intType = objRS(i).Type if Trim(varFieldValue & "") = "" Then rw " " Else Select Case intType Case 2, 3, 4, 5, 17 rw "" & varFieldValue Case 6 rw "" & FormatCurrency(varFieldValue) Case 7 rw "" & FormatDateTime(varFieldValue, myDates) Case Else dim valueLength, valueTrimmed valueLength = Len(varFieldValue) if valueLength > myTextLength then valueTrimmed = Left(varFieldValue,myTextLength) valueTrimmed = valueTrimmed & "..." rw "" & valueTrimmed else rw "" & varFieldValue end if End Select End If rw "
" rw "

 

" rw "" rw "" objRS.Close Set objRS = Nothing myOrder = "" End Function '*** Function exitPage() response.redirect (myExit) End Function '*** Function orderBy(column,page,ascend) '*** dim order if ascend = 1 then order = " ASC" ascend = 0 else order = " DESC" ascend = 1 end if myOrder = "ORDER BY " & column & order Call editList(column,ascend,page) End Function '*** Function optOutput(lower,upper,optName,optValue) rw "" End Function '*** Function showHide(column,ascend,page,shHide)'bn dim temp,x,strFields for x = 1 to request.form("add").Count if strFields = "" then strFields = request.form("add")(x) else strFields = strFields & "'" & request.form("add")(x) end if next Application("showHideList") = strFields Application("myKey") = shHide Call editList(column,ascend,page) End Function '*** Function fieldPreferences(lngRecord) '*** sqlQuery = "SELECT TOP 1 * FROM " & myTable & " WHERE " & myKey & " > 0" Set objRS = objConn.Execute(sqlQuery) intFieldCount = objRS.Fields.Count - 1 rw "" & myTitle & "" If Trim(myStyle & "") <> "" Then rw "" End If rw "" rw "

Fields to Show or Hide

" rw "
" rw "" rw "
" For i = 0 To intFieldCount strName = objRS(i).Name strValue = objRS(i).Value intType = objRS(i).Type rw "" If strName = myKey Then rw "" Else rw "" rw "" End If Next rw "
Show Hide
" & strName & "
(" & clearType(intType) & ")Add Field

 

" rw "

 

" Set objRS = Nothing End Function %>