<%@ language="vbscript"%> <% ' ----------------------------------------------------------------- ' Program : Article Redirect ' Language : ASP/VBScript ' Description : Pulls the reference information of an article from ' the database. A link is provided to the source of ' the article, if available. Information on how to ' obtain reprints is provided otherwise. ' Requirement : ' ----------------------------------------------------------------- ' Ver Date Description of modification ' --- ---------- -------------------------------------------------- ' 1.0 2003/01/07 Original write ' 1.1 2004/01/22 Modify to use external error script. ' Modify so that lack of docID will not ' throw an error. ' ----------------------------------------------------------------- %> <% ' ----------------------------------------------------------------- ' Tell the script to buffer the output and require explicitly ' declared variables ' ----------------------------------------------------------------- Option Explicit Response.Buffer = True %> <% ' ----------------------------------------------------------------- ' Declare and initialize variables ' ----------------------------------------------------------------- Dim objDB, objCmd, objRS, obj_rsAuthor Dim strDSN, strAccessDB, strSQL Dim intCategory Dim int_docID Dim strAuthor Dim strValid, strScriptErr intCategory = 0 int_docID = Request("docID") If Not IsNumeric(int_docID) Then int_docID = 0 End If strValid = "PASS" strScriptErr = "" ' ----------------------------------------------------------------- ' If there is no docID present then just redirect to the ' article listing. ' ----------------------------------------------------------------- If Not int_docID > 0 Then Response.Redirect("default.htm") Response.End() End If ' ----------------------------------------------------------------- ' Create a connection and recordset object to attach to the ' database using the default user account. ' ----------------------------------------------------------------- strAccessDB = "/database/metadata.mdb" strDSN = "Provider=Microsoft.Jet.OLEDB.4.0;" &_ "Data Source=" & server.mappath(strAccessDB) & ";" Set objDB = Server.CreateObject("ADODB.Connection") objDB.Open strDSN set objCmd = Server.CreateObject("ADODB.Command") objCmd.ActiveConnection = objDB objCmd.CommandType = adCmdText objCmd.Prepared = True Set objRS = Server.CreateObject("ADODB.Recordset") objRS.ActiveConnection = objDB objRS.CursorType = adOpenStatic objRS.CursorLocation = adUseClient objRS.LockType = adLockOptimistic strSQL = "SELECT * FROM (tblDocs LEFT JOIN tblPubs ON tblDocs.pubID = tblPubs.pubID) WHERE tblDocs.docID = ?" objCmd.CommandText = strSQL objCmd.Parameters.Append objCmd.CreateParameter(, adInteger, adParamInput, , int_docID) On Error Resume Next objRS.Open(objCmd) If Not Err.Number = 0 Then strValid = "SCRIPT_ERROR" strScriptErr = strScriptErr & createScriptErr(Err.Number, Err.Source, Err.Description) End If While objCmd.Parameters.Count > 0 objCmd.Parameters.Delete(0) Wend On Error Goto 0 Set obj_rsAuthor = Server.CreateObject("ADODB.Recordset") obj_rsAuthor.ActiveConnection = objDB obj_rsAuthor.CursorType = adOpenStatic obj_rsAuthor.CursorLocation = adUseClient obj_rsAuthor.LockType = adLockOptimistic writeBody() ' ----------------------------------------------------------------- ' Close the database recordset and connection objects. ' ----------------------------------------------------------------- On Error Resume Next Set obj_rsAuthor = Nothing objRS.Close() Set objRS = Nothing Set objCmd = Nothing objDB.Close() Set objDB = Nothing On Error Goto 0 ' --------------------------------------------------------------- ' Subprocedure to write the document title. ' --------------------------------------------------------------- Sub docTitle %>Articles<% End Sub ' --------------------------------------------------------------- ' Subprocedure to write the header script. ' --------------------------------------------------------------- Sub docHeader End Sub ' --------------------------------------------------------------- ' Subprocedure to write the footer script. ' --------------------------------------------------------------- Sub docFooter End Sub Function writeBody() %> <% End Function ' --------------------------------------------------------------- ' Subprocedure to write the document body. ' --------------------------------------------------------------- Sub docBody () Response.Write("

Articles

") If strValid = "SCRIPT_ERROR" Then writeScriptError() ElseIf objRS.RecordCount < 1 Then Response.Write("

No information was found for the article requested.

") Else While Not objRS.EOF Response.Write("

The article you have requested is not available on the AAAS Project 2061 Web site. Below is reference information for the article and information on how to view the article or obtain reprints if available.") Response.Write("

" & vbCrLf) strSQL = "SELECT * FROM tblDocAuthor WHERE docID = ?" objCmd.CommandText = strSQL objCmd.Parameters.Append objCmd.CreateParameter(, adInteger, adParamInput, , objRS("docID")) obj_rsAuthor.Open(objCmd) strAuthor = "" While Not obj_rsAuthor.EOF If obj_rsAuthor.AbsolutePosition > 1 Then strAuthor = strAuthor & ", " End If strAuthor = strAuthor & objDB.Execute("SELECT nameLast & ', ' & initFirst AS author FROM tblAuthor WHERE authorID = " & obj_rsAuthor("authorID"))(0) obj_rsAuthor.MoveNext() Wend obj_rsAuthor.Close() Response.Write(strAuthor & " " & Year(objRS("dateRelease")) & ". " & objRS("docTitle")) If InStr(".?", Right(objRS("docTitle"), 1)) = 0 Then Response.Write(". ") Else Response.Write(" ") End If If objRS("tblDocs.pubID") > 0 Then Response.Write("" & objRS("pubTitle")) If Len(objRS("pubVolume")) > 0 Then Response.Write(", " & objRS("pubVolume") & "") If Len(objRS("pubNumber")) > 0 Then Response.Write(" (" & objRS("pubNumber") & ")") End If ElseIf Len(objRS("pubIssue")) > 0 Then Response.Write(", " & objRS("pubIssue")) Else Response.Write("") End If If Not IsNull(objRS("pages")) Then Response.Write(", " & objRS("pages")) End If Response.Write(".") End If Response.Write("
") If Len(objRS("addInfo")) > 0 Then Response.Write("
" & objRS("addInfo")) End If If Len(objRS("reprints")) > 0 Then Response.Write("
" & objRS("reprints")) End If Response.Write("

" & vbCrLf) objRS.MoveNext() Wend End If End Sub %>