%@ 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("
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("