<% ' Generic ASP Editor for Access Tables ' Version 1.11 - 21 March 2000 ' © Roman Koch (roman@romankoch.ch / http://www.romankoch.ch) ' --------------------------------------------------------------------- ' Mandatory customisations ' myMDB The absolute path to your .mdb file, as seen on the server ' myTable The name of the Access table ' myKey The field name of the primary key field, must be "Autonumber" type ' myTrueWord The value for a boolean "true" in your local language, e.g. "TRUE" in English or "WAHR" in German ' myPage The number of records per page 'response.Write(Server.MapPath("\bds\lemerusados.mdb")) Const myMDB = "\\NOCFiler02\Host03\lemeridien\bds\lemerusados.mdb" Const myTable = "Usados" Const myKey = "ID" Const myTrueWord = "True" Const myPage = 100 ' --------------------------------------------------------------------- ' Optional customisations ' myOrder SQL "Order By" clause, e.g. "ORDER BY Name ASC, Age DESC" ' myWhere SQL "Where" clause, e.g. "WHERE Age > 20" ' myStyle Cascading Style Sheet, e.g. "../Tools/css_body.css" ' myStripes Alternate color, e.g. "#CCB6B5" ' myDates Date formatting (0=GeneralDate, 1=LongDate, 2=ShortDate, 3=LongTime, 4=ShortTime) ' myDebug Debug mode - True or False. If true, debugging comments are added to the HTML output Const myOrder = "" Const myWhere = "" Const myStyle = "" Const myStripes = "" Const myDates = 0 Const myDebug = False ' ===================================================================== ' End of the customisation section ' ===================================================================== Const adUseClient = 3 Const adOpenForwardOnly = 0 Const adLockBatchOptimistic = 4 Const myVersion = "1.11" Dim objConn If isObject(Session("mdbDefined")) Then Set objConn = Session("mdbDefined") Else Set objConn = Server.CreateObject("ADODB.Connection") objConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myMDB & ";Persist Security Info=False" objConn.Open Set Session("mdbDefined") = objConn End If 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") If lngPage = "" Then lngPage = 1 lngPage = CLng(lngPage) If myDebug then Response.Write "" & vbCrLf End If Select Case strAction Case "list" 'list all records Call editList() Case "update" 'Get the current record and display in a form for editing Call editUpdate(lngRecord) Case "updateExec" 'Save the changes Call editUpdateExec(lngRecord) Case "insert" 'Display an empty form for entering a new record Call editInsert() Case "insertExec" 'Save the new record Call editInsertExec() Case "delete" 'Display the current record so deletion can be confirmed Call editDelete(lngRecord) Case "deleteExec" 'Delete the record Call editDeleteExec(lngRecord) Case Else 'same as list parameter Call editList() 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 = "Boolean" Case 17 strFieldType = "Byte" Case 7 strFieldType = "Date/Time" Case Else strFieldType = "String" 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 Response.Write "Access Table Editor" If Trim(myStyle & "") <> "" Then Response.Write "" End If Response.Write "" Response.Write "

Update Record

" Response.Write "
" Response.Write "" For i = 0 To intFieldCount strName = objRS(i).Name strValue = objRS(i).Value intType = objRS(i).Type Response.Write "" If strName = myKey Then Response.Write "" Else Response.Write "" End If Next Response.Write "
" & strName & "
(" & clearType(intType) & ")

 

" Response.Write "

 

" 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) If strName <> myKey Then 'skip primary key Select Case intType Case 2, 3, 4, 5, 6, 17 'number fields If not IsNumeric(strNewValue) Then strNewValue = Null Case 11 'yes/no fields If UCase(strNewValue) = strMyTrueWord Then strNewValue = True Else strNewValue = False End If Case 7 'date/time fields If not IsDate(strNewValue) Then strNewValue = Null Case Else 'string fields If Trim(strNewValue) & "" = "" Then strNewValue = Null End Select objRS(strName) = strNewValue End If Next objRS.Update objRS.Close Set objRS = Nothing Response.Redirect strMyName & "?page=" & lngPage End Function '====================================================================== Function editInsert() '====================================================================== Response.Write "Access Table Editor" If Trim(myStyle & "") <> "" Then Response.Write "" End If Response.Write "" Response.Write "

Create Record

" Response.Write "
" Response.Write "" 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 Response.Write "" Response.Write "" End If Next Response.Write "
" & strName & " (" & clearType(intType) & ")

 

" Response.Write "

 

" 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 = Request.Form(strName) If strName <> myKey Then 'skip primary key Select Case intType Case 2, 3, 4, 5, 6, 17 'number fields If not IsNumeric(strNewValue) Then strNewValue = Null Case 11 'yes/no fields If Trim(strNewValue & "") = "" Then strNewValue = False Else If UCase(strNewValue) = strMyTrueWord Then strNewValue = True Else strNewValue = False End If End If Case 7 'date/time fields If not IsDate(strNewValue) Then strNewValue = Null Case Else 'string fields If Trim(strNewValue) & "" = "" Then strNewValue = Null End Select objRS(strName) = strNewValue End If Next objRS.Update objRS.Close Set objRS = Nothing Response.Redirect strMyName & "?page=" & lngPage End Function '====================================================================== Function editDelete(lngRecord) '====================================================================== sqlQuery = "SELECT * FROM " & myTable & " WHERE " & myKey & "=" & lngRecord Set objRS = objConn.Execute(sqlQuery) intFieldCount = objRS.Fields.Count - 1 Response.Write "Access Table Editor" If Trim(myStyle & "") <> "" Then Response.Write "" End If Response.Write "" Response.Write "

Delete Record

" Response.Write "
" Response.Write "" For i = 0 To intFieldCount strName = objRS(i).Name strValue = objRS(i).Value Response.Write "" Response.Write "" Next Response.Write "
" & strName & "

 

" Response.Write "

 

" objRS.Close Set objRS = Nothing End Function '====================================================================== Function editDeleteExec(lngRecord) '====================================================================== objConn.Execute("DELETE * FROM " & myTable & " WHERE " & myKey & "=" & lngRecord) Response.Redirect strMyName & "?page=" & lngPage End Function '====================================================================== Function editList() '====================================================================== 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 'this may happen after a Delete operation lngPage = objRS.PageCount response.write "lngpage greater than objRS.PageCount: " & lngPage & "/" & objRS.PageCount end if Response.Write "Access Table Editor" If Trim(myStyle & "") <> "" Then Response.Write "" End If Response.Write "" Response.Write "" & vbCrLf Response.Write "

" & uCase(myTable) & "

" & vbCrLf lngMaxPages = objRS.PageCount If myDebug Then Response.Write "" & vbCrLf End If Response.Write "

Page " & lngPage & " of " & lngMaxPages & "   " Response.Write "First " If lngPage = 1 Then lngPrevNext = 1 Else lngPrevNext = lngPage - 1 Response.Write "Previous " If lngPage = lngMaxPages Then lngPrevNext = lngMaxPages Else lngPrevNext = lngPage + 1 Response.Write "Next " Response.Write "Last " Response.Write "  Refresh

" Response.Write "" Response.Write "" Response.Write "" For i = 0 To intFieldCount If objRS(i).Type > 7 then Response.Write "" Next Response.Write "" & vbCrLf If objRS.EOF Then Response.Write "" Else '----- List records ----- intCounter = 0 objRS.AbsolutePage = lngPage For intPager = 1 to myPage intCounter = intCounter + 1 Response.Write " "" Then If intCounter Mod 2 <> 0 Then Response.Write " bgcolor=" & myStripes End If End If Response.Write ">" Response.Write vbCrLf & "" & vbCrLf For i = 0 To intFieldCount varFieldValue = objRS(i) intType = objRS(i).Type if Trim(varFieldValue & "") = "" Then Response.Write "" & vbCrLf Next Response.Write "" & vbCrLf objRS.Movenext If objRS.EOF Then Exit For Next End If Response.Write "
Command" Else Response.Write "" End If Response.Write objRS(i).Name & "
New
Edit " Response.Write "New " Response.Write "Del " Else Select Case intType Case 2, 3, 4, 5, 17 Response.Write "" & varFieldValue Case 6 Response.Write "" & FormatCurrency(varFieldValue) Case 7 Response.Write "" & FormatDateTime(varFieldValue, myDates) Case Else Response.Write "" & varFieldValue End Select End If Response.Write "
" Response.Write "

 

" objRS.Close Set objRS = Nothing End Function %>