home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 July & August / Pcwk78a98.iso / Micrsoft / VJ / COMMON / WIZARD98 / VIWZ1.DLL / 1033 / HTMX / 5531 < prev    next >
Text File  |  1998-02-24  |  8KB  |  232 lines
  1. <%@ LANGUAGE="VBScript" %>
  2.  
  3. <%
  4. '-------------------------------------------------------------------------------
  5. ' Microsoft Visual InterDev - Data Form Wizard
  6. ' 
  7. ' List Page
  8. '
  9. ' (c) 1997 Microsoft Corporation.  All Rights Reserved.
  10. '
  11. ' This file is an Active Server Page that contains the list view of a Data Form. 
  12. ' It requires Microsoft Internet Information Server 3.0 and can be displayed
  13. ' using any browser that supports tables. You can edit this file to further 
  14. ' customize the list view.
  15. '
  16. '-------------------------------------------------------------------------------
  17.  
  18. Dim strPagingMove
  19. Dim strDFName
  20. strDFName = "rs<%#TableShortName#%>"
  21. %>
  22.  
  23. <SCRIPT RUNAT=Server LANGUAGE="VBScript">
  24.  
  25. '---- DataTypeEnum Values ----
  26. Const adUnsignedTinyInt = 17
  27. Const adBoolean = 11
  28. Const adLongVarChar = 201
  29. Const adLongVarWChar = 203
  30. Const adBinary = 128
  31. Const adVarBinary = 204
  32. Const adLongVarBinary = 205
  33.  
  34. '-------------------------------------------------------------------------------
  35. ' Purpose:  Substitutes Empty for Null and trims leading/trailing spaces
  36. ' Inputs:   varTemp    - the target value
  37. ' Returns:    The processed value
  38. '-------------------------------------------------------------------------------
  39.  
  40. Function ConvertNull(varTemp)
  41.     If IsNull(varTemp) Then
  42.         ConvertNull = ""
  43.     Else
  44.         ConvertNull = Trim(varTemp)
  45.     End If
  46. End Function
  47.  
  48. '-------------------------------------------------------------------------------
  49. ' Purpose:  Embeds bracketing quotes around the string
  50. ' Inputs:   varTemp    - the target value
  51. ' Returns:    The processed value
  52. '-------------------------------------------------------------------------------
  53.  
  54. Function QuotedString(varTemp)
  55.     If IsNull(varTemp) Then
  56.         QuotedString = Chr(34) & Chr(34)
  57.     Else
  58.         QuotedString = Chr(34) & CStr(varTemp) & Chr(34)
  59.     End If
  60. End Function
  61.  
  62. '-------------------------------------------------------------------------------
  63. ' Purpose:  Tests string to see if it is a URL by looking for protocol
  64. ' Inputs:   varTemp    - the target value
  65. ' Returns:    True - if is URL, False if not
  66. '-------------------------------------------------------------------------------
  67.  
  68. Function IsURL(varTemp)
  69.     IsURL = True
  70.     If UCase(Left(Trim(varTemp), 6)) = "HTTP:/" Then Exit Function
  71.     If UCase(Left(Trim(varTemp), 6)) = "FILE:/" Then Exit Function
  72.     If UCase(Left(Trim(varTemp), 8)) = "MAILTO:/" Then Exit Function
  73.     If UCase(Left(Trim(varTemp), 5)) = "FTP:/" Then Exit Function
  74.     If UCase(Left(Trim(varTemp), 8)) = "GOPHER:/" Then Exit Function
  75.     If UCase(Left(Trim(varTemp), 6)) = "NEWS:/" Then Exit Function
  76.     If UCase(Left(Trim(varTemp), 7)) = "HTTPS:/" Then Exit Function
  77.     If UCase(Left(Trim(varTemp), 8)) = "TELNET:/" Then Exit Function
  78.     If UCase(Left(Trim(varTemp), 6)) = "NNTP:/" Then Exit Function
  79.     IsURL = False
  80. End Function
  81.  
  82. '-------------------------------------------------------------------------------
  83. ' Purpose:  Handles the display of a field from a recordset depending
  84. '            on its data type, attributes, and the current mode.
  85. ' Assumes:     That the recordset containing the field is open
  86. ' Inputs:   strFieldName     - the name of the field in the recordset
  87. '            avarLookup        - array of lookup values
  88. '-------------------------------------------------------------------------------
  89.  
  90. Function ShowField(strFieldName, avarLookup)
  91.     Dim intRow
  92.     Dim strPartial
  93.     Dim strBool
  94.     Dim nPos
  95.     strFieldValue = ""
  96.     nPos=Instr(strFieldName,".")
  97.     Do While nPos > 0 
  98.         strFieldName= Mid (strFieldName, nPos+1)
  99.         nPos=Instr(strFieldName,".")
  100.     Loop 
  101.     If Not IsNull(avarLookup) Then
  102.         Response.Write "<TD BGCOLOR=White NOWRAP><FONT SIZE=-1>" 
  103.         For intRow = 0 to UBound(avarLookup, 2)
  104.             If ConvertNull(avarLookup(0, intRow)) = ConvertNull(rs<%#TableShortName#%>(strFieldName)) Then
  105.                 Response.Write Server.HTMLEncode(ConvertNull(avarLookup(1, intRow)))
  106.                 Exit For
  107.             End If
  108.         Next
  109.         Response.Write "</FONT></TD>"
  110.         Exit Function
  111.     End If
  112.     
  113.     Select Case rs<%#TableShortName#%>(strFieldName).Type
  114.         Case adBoolean, adUnsignedTinyInt                'Boolean
  115.             strBool = ""
  116.             If rs<%#TableShortName#%>(strFieldName) <> 0 Then
  117.                 strBool = "True"
  118.             Else
  119.                 strBool = "False"
  120.             End If
  121.             Response.Write "<TD BGCOLOR=White ><FONT SIZE=-1>" & strBool & "</FONT></TD>"
  122.             
  123.         Case adBinary, adVarBinary, adLongVarBinary        'Binary
  124.             Response.Write "<TD BGCOLOR=White ><FONT SIZE=-1>[Binary]</FONT></TD>"
  125.             
  126.         Case adLongVarChar, adLongVarWChar                'Memo
  127.             Response.Write "<TD BGCOLOR=White NOWRAP><FONT SIZE=-1>"
  128.             strPartial = Left(rs<%#TableShortName#%>(strFieldName), 50)            
  129.             If ConvertNull(strPartial) = "" Then
  130.                 Response.Write " "
  131.             Else
  132.                 Response.Write Server.HTMLEncode(strPartial)
  133.             End If
  134.             If rs<%#TableShortName#%>(strFieldName).ActualSize > 50 Then Response.Write "..."
  135.             Response.Write "</FONT></TD>"
  136.             
  137.         Case Else
  138.             Response.Write "<TD BGCOLOR=White ALIGN=Left NOWRAP><FONT SIZE=-1>"
  139.             If ConvertNull(rs<%#TableShortName#%>(strFieldName)) = "" Then
  140.                 Response.Write " "
  141.             Else
  142.                 ' Check for special field types
  143.                 Select Case UCase(Left(rs<%#TableShortName#%>(strFieldName).Name, 4))
  144.                     Case "URL_"
  145.                         Response.Write "<A HREF=" & QuotedString(rs<%#TableShortName#%>(strFieldName)) & ">"
  146.                         Response.Write Server.HTMLEncode(ConvertNull(rs<%#TableShortName#%>(strFieldName)))
  147.                         Response.Write "</A>"
  148.                     Case Else
  149.                         If IsURL(rs<%#TableShortName#%>(strFieldName)) Then
  150.                             Response.Write "<A HREF=" & QuotedString(rs<%#TableShortName#%>(strFieldName)) & ">"
  151.                             Response.Write Server.HTMLEncode(ConvertNull(rs<%#TableShortName#%>(strFieldName)))
  152.                             Response.Write "</A>"
  153.                         Else
  154.                             Response.Write Server.HTMLEncode(ConvertNull(rs<%#TableShortName#%>(strFieldName)))
  155.                         End If
  156.                 End Select
  157.             End If
  158.             Response.Write "</FONT></TD>"
  159.     End Select
  160. End Function
  161.  
  162. </SCRIPT>
  163.  
  164. <HTML>
  165. <HEAD>
  166.     <META NAME="GENERATOR" CONTENT="Microsoft Visual InterDev">
  167.     <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
  168.     <META NAME="Keywords" CONTENT="Microsoft Data Form, <%#FormName#%> List">
  169.     <TITLE><%#FormName#%> List</TITLE>
  170. </HEAD>
  171.  
  172. <!--------------------------- Formatting Section ------------------------------>
  173.  
  174. <BASEFONT FACE="Arial, Helvetica, sans-serif">
  175. <LINK REL=STYLESHEET HREF="./Stylesheets/<%#THEMENAME#%>/Style2.css">
  176. <BODY BACKGROUND="./Images/<%#THEMENAME#%>/Background/Back2.jpg" BGCOLOR=White>
  177.  
  178. <!---------------------------- Lookups Section ------------------------------->
  179. <%#ForeignKeyRS#%>
  180. <!---------------------------- Heading Section ------------------------------->
  181.  
  182. <% Response.Write "<FORM ACTION=<%#DataFormFileName#%> METHOD=""POST"">" %>
  183. <TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=0 BORDER=0>
  184.     <TR>
  185.         <TH NOWRAP BGCOLOR=Silver ALIGN=Left BACKGROUND="./Images/<%#THEMENAME#%>/Navigation/Nav1.jpg" >
  186.             <FONT SIZE=6> <%#FormName#%></FONT>
  187.         </TH>
  188.         <TD BGCOLOR=Silver VALIGN=Middle ALIGN=Right WIDTH=100% BACKGROUND="./Images/<%#THEMENAME#%>/Navigation/Nav1.jpg">
  189.             <INPUT TYPE="Hidden" NAME="FormMode" VALUE="Edit">
  190. <%#ChangeToFormView#%>
  191.         </TD>
  192.     </TR>
  193. <%#StatusLineList#%></TABLE>
  194. </FORM>
  195.  
  196. <!----------------------------- List Section --------------------------------->
  197.  
  198. <TABLE CELLSPACING=0 CELLPADDING=0 BORDER=0 WIDTH=100% >
  199. <TR>
  200. <TD WIDTH=20> </TD>
  201. <TD>
  202. <TABLE CELLSPACING=1 CELLPADDING=1 BORDER=0 WIDTH=100% >
  203.     <TR BGCOLOR=SILVER VALIGN=TOP>
  204.         <TD ALIGN=Center><FONT SIZE=-1> # </FONT></TD>
  205. <%#DisplayFieldListHTML#%>    </TR>
  206.  
  207. <%#DataRangeHeaderHTMLList#%>
  208.  
  209.     <TR VALIGN=TOP>
  210.         <TD BGCOLOR=White><FONT SIZE=-1>
  211. <%#HotLinkHTML#%>        </FONT></TD>
  212.         <%
  213. <%#RemainingFields#%>        fHideRule = True
  214.         %>
  215.     </TR>
  216.  
  217. <%#DataRangeFooterHTMLList#%>
  218.  
  219. <!---------------------------- Footer Section -------------------------------->
  220.  
  221. <% 
  222. ' TEMP: cache here until CacheRecordset property is implemented in
  223. '         data range
  224. If fNeedRecordset Then
  225.     Set Session("rs<%#TableShortName#%>_Recordset") = rs<%#TableShortName#%>
  226. End If 
  227. %>
  228.  
  229. </TD></TR></TABLE>
  230. </BODY>
  231. </HTML>