home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1998 April B
/
Pcwk4b98.iso
/
ie401gb
/
IEAK4.CAB
/
corplist.asp
< prev
next >
Wrap
Text File
|
1997-10-08
|
17KB
|
457 lines
<%@ LANGUAGE="VBScript" %>
<%
'-------------------------------------------------------------------------------
' Microsoft Visual InterDev - Data Form Wizard
'
' List Page
'
' (c) 1997 Microsoft Corporation. All Rights Reserved.
'
' This file is an Active Server Page that contains the list view of a Data Form.
' It requires Microsoft Internet Information Server 3.0 and can be displayed
' using any browser that supports tables. You can edit this file to further
' customize the list view.
'
'-------------------------------------------------------------------------------
Dim strPagingMove
Dim strDFName
strDFName = "rsCorpAdminIEGroup"
%>
<SCRIPT RUNAT=Server LANGUAGE="VBScript">
'---- DataTypeEnum Values ----
Const adUnsignedTinyInt = 17
Const adBoolean = 11
Const adLongVarChar = 201
Const adLongVarWChar = 203
Const adBinary = 128
Const adVarBinary = 204
Const adLongVarBinary = 205
'-------------------------------------------------------------------------------
' Purpose: Substitutes Empty for Null and trims leading/trailing spaces
' Inputs: varTemp - the target value
' Returns: The processed value
'-------------------------------------------------------------------------------
Function ConvertNull(varTemp)
If IsNull(varTemp) Then
ConvertNull = ""
Else
ConvertNull = Trim(varTemp)
End If
End Function
'-------------------------------------------------------------------------------
' Purpose: Embeds bracketing quotes around the string
' Inputs: varTemp - the target value
' Returns: The processed value
'-------------------------------------------------------------------------------
Function QuotedString(varTemp)
If IsNull(varTemp) Then
QuotedString = Chr(34) & Chr(34)
Else
QuotedString = Chr(34) & CStr(varTemp) & Chr(34)
End If
End Function
'-------------------------------------------------------------------------------
' Purpose: Tests string to see if it is a URL by looking for protocol
' Inputs: varTemp - the target value
' Returns: True - if is URL, False if not
'-------------------------------------------------------------------------------
Function IsURL(varTemp)
IsURL = True
If UCase(Left(Trim(varTemp), 6)) = "HTTP:/" Then Exit Function
If UCase(Left(Trim(varTemp), 6)) = "FILE:/" Then Exit Function
If UCase(Left(Trim(varTemp), 8)) = "MAILTO:/" Then Exit Function
If UCase(Left(Trim(varTemp), 5)) = "FTP:/" Then Exit Function
If UCase(Left(Trim(varTemp), 8)) = "GOPHER:/" Then Exit Function
If UCase(Left(Trim(varTemp), 6)) = "NEWS:/" Then Exit Function
If UCase(Left(Trim(varTemp), 7)) = "HTTPS:/" Then Exit Function
If UCase(Left(Trim(varTemp), 8)) = "TELNET:/" Then Exit Function
If UCase(Left(Trim(varTemp), 6)) = "NNTP:/" Then Exit Function
IsURL = False
End Function
'-------------------------------------------------------------------------------
' Purpose: Handles the display of a field from a recordset depending
' on its data type, attributes, and the current mode.
' Assumes: That the recordset containing the field is open
' Inputs: strFieldName - the name of the field in the recordset
' avarLookup - array of lookup values
'-------------------------------------------------------------------------------
Function ShowField(strFieldName, avarLookup)
Dim intRow
Dim strPartial
Dim strBool
Dim nPos
strFieldValue = ""
nPos=Instr(strFieldName,".")
Do While nPos > 0
strFieldName= Mid (strFieldName, nPos+1)
nPos=Instr(strFieldName,".")
Loop
If Not IsNull(avarLookup) Then
Response.Write "<TD BGCOLOR=White NOWRAP><FONT SIZE=-1>"
For intRow = 0 to UBound(avarLookup, 2)
If ConvertNull(avarLookup(0, intRow)) = ConvertNull(rsCorpAdminIEGroup(strFieldName)) Then
Response.Write Server.HTMLEncode(ConvertNull(avarLookup(1, intRow)))
Exit For
End If
Next
Response.Write "</FONT></TD>"
Exit Function
End If
Select Case rsCorpAdminIEGroup(strFieldName).Type
Case adBoolean, adUnsignedTinyInt 'Boolean
strBool = ""
If rsCorpAdminIEGroup(strFieldName) <> 0 Then
strBool = "True"
Else
strBool = "False"
End If
Response.Write "<TD BGCOLOR=White ><FONT SIZE=-1>" & strBool & "</FONT></TD>"
Case adBinary, adVarBinary, adLongVarBinary 'Binary
Response.Write "<TD BGCOLOR=White ><FONT SIZE=-1>[Binary]</FONT></TD>"
Case adLongVarChar, adLongVarWChar 'Memo
Response.Write "<TD BGCOLOR=White NOWRAP><FONT SIZE=-1>"
strPartial = Left(rsCorpAdminIEGroup(strFieldName), 50)
If ConvertNull(strPartial) = "" Then
Response.Write " "
Else
Response.Write Server.HTMLEncode(strPartial)
End If
If rsCorpAdminIEGroup(strFieldName).ActualSize > 50 Then Response.Write "..."
Response.Write "</FONT></TD>"
Case Else
Response.Write "<TD BGCOLOR=White ALIGN=Left NOWRAP><FONT SIZE=-1>"
If ConvertNull(rsCorpAdminIEGroup(strFieldName)) = "" Then
Response.Write " "
Else
' Check for special field types
Select Case UCase(Left(rsCorpAdminIEGroup(strFieldName).Name, 4))
Case "URL_"
Response.Write "<A HREF=" & QuotedString(rsCorpAdminIEGroup(strFieldName)) & ">"
Response.Write Server.HTMLEncode(ConvertNull(rsCorpAdminIEGroup(strFieldName)))
Response.Write "</A>"
Case Else
If IsURL(rsCorpAdminIEGroup(strFieldName)) Then
Response.Write "<A HREF=" & QuotedString(rsCorpAdminIEGroup(strFieldName)) & ">"
Response.Write Server.HTMLEncode(ConvertNull(rsCorpAdminIEGroup(strFieldName)))
Response.Write "</A>"
Else
Response.Write Server.HTMLEncode(ConvertNull(rsCorpAdminIEGroup(strFieldName)))
End If
End Select
End If
Response.Write "</FONT></TD>"
End Select
End Function
</SCRIPT>
<HTML>
<HEAD>
<META NAME="GENERATOR" CONTENT="Microsoft Visual InterDev">
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
<META NAME="Keywords" CONTENT="Microsoft Data Form, IEAK CorpAdmin List">
<TITLE>IEAK CorpAdmin List</TITLE>
</HEAD>
<!--------------------------- Formatting Section ------------------------------>
<BASEFONT FACE="Arial, Helvetica, sans-serif">
<LINK REL=STYLESHEET HREF="./Stylesheets/Grid/Style2.css">
<BODY BACKGROUND="./Images/Grid/Background/Back2.jpg" BGCOLOR=White>
<!---------------------------- Lookups Section ------------------------------->
<!---------------------------- Heading Section ------------------------------->
<% Response.Write "<FORM ACTION=CorpAdminForm.asp METHOD=""POST"">" %>
<TABLE WIDTH=100% CELLSPACING=0 CELLPADDING=0 BORDER=0>
<TR>
<TH NOWRAP BGCOLOR=Silver ALIGN=Left BACKGROUND="./Images/Grid/Navigation/Nav1.jpg" >
<FONT SIZE=6> IEAK CorpAdmin</FONT>
</TH>
<TD BGCOLOR=Silver VALIGN=Middle ALIGN=Right WIDTH=100% BACKGROUND="./Images/Grid/Navigation/Nav1.jpg">
<INPUT TYPE="Hidden" NAME="FormMode" VALUE="Edit">
<INPUT TYPE="SUBMIT" NAME="DataAction" VALUE="Form View">
</TD>
</TR>
<TR>
<TD BGCOLOR=#FFFFCC COLSPAN=3>
<FONT SIZE=-1>
<%
If IsEmpty(Session("rsCorpAdminIEGroup_Filter")) Or Session("rsCorpAdminIEGroup_Filter")="" Then
Response.Write "Current Filter: None<BR>"
Else
Response.Write "Current Filter: " & Session("rsCorpAdminIEGroup_FilterDisplay") & "<BR>"
End If
%>
</FONT>
</TD>
</TR></TABLE>
</FORM>
<!----------------------------- List Section --------------------------------->
<TABLE CELLSPACING=0 CELLPADDING=0 BORDER=0 WIDTH=100% >
<TR>
<TD WIDTH=20> </TD>
<TD>
<TABLE CELLSPACING=1 CELLPADDING=1 BORDER=0 WIDTH=100% >
<TR BGCOLOR=SILVER VALIGN=TOP>
<TD ALIGN=Center><FONT SIZE=-1> # </FONT></TD>
<TD ALIGN=Left><FONT SIZE=-1><B>GroupID</B></FONT></TD>
<TD ALIGN=Left><FONT SIZE=-1><B>GroupName</B></FONT></TD>
<TD ALIGN=Left><FONT SIZE=-1><B>INSFile</B></FONT></TD>
</TR>
<!--METADATA TYPE="DesignerControl" startspan
<OBJECT ID="rsCorpAdminIEGroup" WIDTH=151 HEIGHT=24
CLASSID="CLSID:F602E721-A281-11CF-A5B7-0080C73AAC7E">
<PARAM NAME="BarAlignment" VALUE="0">
<PARAM NAME="PageSize" VALUE="10">
<PARAM Name="RangeType" Value="2">
<PARAM Name="DataConnection" Value="DataConn">
<PARAM Name="CommandType" Value="0">
<PARAM Name="CommandText" Value="SELECT `GroupID`, `GroupName`, `INSFile` FROM `IEGroup`">
<PARAM Name="CursorType" Value="1">
<PARAM Name="LockType" Value="3">
<PARAM Name="CacheRecordset" Value="1">
</OBJECT>
-->
<%
fHideNavBar = False
fHideNumber = False
fHideRequery = False
fHideRule = False
stQueryString = ""
fEmptyRecordset = False
fFirstPass = True
fNeedRecordset = False
fNoRecordset = False
tBarAlignment = "Left"
tHeaderName = "rsCorpAdminIEGroup"
tPageSize = 10
tPagingMove = ""
tRangeType = "Table"
tRecordsProcessed = 0
tPrevAbsolutePage = 0
intCurPos = 0
intNewPos = 0
fSupportsBookmarks = True
fMoveAbsolute = False
If Not IsEmpty(Request("rsCorpAdminIEGroup_PagingMove")) Then
tPagingMove = Trim(Request("rsCorpAdminIEGroup_PagingMove"))
End If
If IsEmpty(Session("rsCorpAdminIEGroup_Recordset")) Then
fNeedRecordset = True
Else
If Session("rsCorpAdminIEGroup_Recordset") Is Nothing Then
fNeedRecordset = True
Else
Set rsCorpAdminIEGroup = Session("rsCorpAdminIEGroup_Recordset")
End If
End If
If fNeedRecordset Then
Set DataConn = Server.CreateObject("ADODB.Connection")
DataConn.ConnectionTimeout = Session("DataConn_ConnectionTimeout")
DataConn.CommandTimeout = Session("DataConn_CommandTimeout")
DataConn.Open Session("DataConn_ConnectionString"), Session("DataConn_RuntimeUserName"), Session("DataConn_RuntimePassword")
Set cmdTemp = Server.CreateObject("ADODB.Command")
Set rsCorpAdminIEGroup = Server.CreateObject("ADODB.Recordset")
cmdTemp.CommandText = "SELECT `GroupID`, `GroupName`, `INSFile` FROM `IEGroup`"
cmdTemp.CommandType = 1
Set cmdTemp.ActiveConnection = DataConn
rsCorpAdminIEGroup.Open cmdTemp, , 1, 3
End If
On Error Resume Next
If rsCorpAdminIEGroup.BOF And rsCorpAdminIEGroup.EOF Then fEmptyRecordset = True
On Error Goto 0
If Err Then fEmptyRecordset = True
If fNeedRecordset Then
Set Session("rsCorpAdminIEGroup_Recordset") = rsCorpAdminIEGroup
End If
rsCorpAdminIEGroup.PageSize = tPageSize
fSupportsBookmarks = rsCorpAdminIEGroup.Supports(8192)
If Not IsEmpty(Session("rsCorpAdminIEGroup_Filter")) And Not fEmptyRecordset Then
rsCorpAdminIEGroup.Filter = Session("rsCorpAdminIEGroup_Filter")
If rsCorpAdminIEGroup.BOF And rsCorpAdminIEGroup.EOF Then fEmptyRecordset = True
End If
If IsEmpty(Session("rsCorpAdminIEGroup_PageSize")) Then Session("rsCorpAdminIEGroup_PageSize") = tPageSize
If IsEmpty(Session("rsCorpAdminIEGroup_AbsolutePage")) Then Session("rsCorpAdminIEGroup_AbsolutePage") = 1
If Session("rsCorpAdminIEGroup_PageSize") <> tPageSize Then
tCurRec = ((Session("rsCorpAdminIEGroup_AbsolutePage") - 1) * Session("rsCorpAdminIEGroup_PageSize")) + 1
tNewPage = Int(tCurRec / tPageSize)
If tCurRec Mod tPageSize <> 0 Then
tNewPage = tNewPage + 1
End If
If tNewPage = 0 Then tNewPage = 1
Session("rsCorpAdminIEGroup_PageSize") = tPageSize
Session("rsCorpAdminIEGroup_AbsolutePage") = tNewPage
End If
If fEmptyRecordset Then
fHideNavBar = True
fHideRule = True
Else
tPrevAbsolutePage = Session("rsCorpAdminIEGroup_AbsolutePage")
Select Case tPagingMove
Case ""
fMoveAbsolute = True
Case "Requery"
rsCorpAdminIEGroup.Requery
fMoveAbsolute = True
Case "<<"
Session("rsCorpAdminIEGroup_AbsolutePage") = 1
Case "<"
If Session("rsCorpAdminIEGroup_AbsolutePage") > 1 Then
Session("rsCorpAdminIEGroup_AbsolutePage") = Session("rsCorpAdminIEGroup_AbsolutePage") - 1
End If
Case ">"
If Not rsCorpAdminIEGroup.EOF Then
Session("rsCorpAdminIEGroup_AbsolutePage") = Session("rsCorpAdminIEGroup_AbsolutePage") + 1
End If
Case ">>"
If fSupportsBookmarks Then
Session("rsCorpAdminIEGroup_AbsolutePage") = rsCorpAdminIEGroup.PageCount
End If
End Select
Do
If fSupportsBookmarks Then
rsCorpAdminIEGroup.AbsolutePage = Session("rsCorpAdminIEGroup_AbsolutePage")
Else
If fNeedRecordset Or fMoveAbsolute Or rsCorpAdminIEGroup.EOF Then
rsCorpAdminIEGroup.MoveFirst
rsCorpAdminIEGroup.Move (Session("rsCorpAdminIEGroup_AbsolutePage") - 1) * tPageSize
Else
intCurPos = ((tPrevAbsolutePage - 1) * tPageSize) + tPageSize
intNewPos = ((Session("rsCorpAdminIEGroup_AbsolutePage") - 1) * tPageSize) + 1
rsCorpAdminIEGroup.Move intNewPos - intCurPos
End If
If rsCorpAdminIEGroup.BOF Then rsCorpAdminIEGroup.MoveNext
End If
If Not rsCorpAdminIEGroup.EOF Then Exit Do
Session("rsCorpAdminIEGroup_AbsolutePage") = Session("rsCorpAdminIEGroup_AbsolutePage") - 1
Loop
End If
Do
If fEmptyRecordset Then Exit Do
If tRecordsProcessed = tPageSize Then Exit Do
If Not fFirstPass Then
rsCorpAdminIEGroup.MoveNext
Else
fFirstPass = False
End If
If rsCorpAdminIEGroup.EOF Then Exit Do
tRecordsProcessed = tRecordsProcessed + 1
%>
<!--METADATA TYPE="DesignerControl" endspan-->
<TR VALIGN=TOP>
<TD BGCOLOR=White><FONT SIZE=-1>
<%
If tPageSize > 0 Then
tCurRec = ((Session("rsCorpAdminIEGroup_AbsolutePage") - 1) * tPageSize) + tRecordsProcessed
Else
tRecordsProcessed = tRecordsProcessed + 1
tCurRec = tRecordsProcessed
End If
Response.Write "<A HREF=" & QuotedString("CorpAdminAction.asp?Bookmark=" & tCurRec & "&DataAction=Find") & ">" & tCurRec & "</A>"
%>
</FONT></TD>
<%
ShowField "GroupID", Null
ShowField "GroupName", Null
ShowField "INSFile", Null
fHideRule = True
%>
</TR>
<!--METADATA TYPE="DesignerControl" startspan
<OBJECT ID="DataRangeFtr1" WIDTH=151 HEIGHT=24
CLASSID="CLSID:F602E722-A281-11CF-A5B7-0080C73AAC7E">
</OBJECT>
-->
<%
Loop
If tRangeType = "Table" Then Response.Write "</TABLE>"
If tPageSize > 0 Then
If Not fHideRule Then Response.Write "<HR>"
If Not fHideNavBar Then
%>
<TABLE WIDTH=100% >
<TR>
<TD WIDTH=100% >
<P ALIGN=<%= tBarAlignment %> >
<FORM <%= "ACTION=""" & Request.ServerVariables("PATH_INFO") & stQueryString & """" %> METHOD="POST">
<INPUT TYPE="Submit" NAME="<%= tHeaderName & "_PagingMove" %>" VALUE=" << ">
<INPUT TYPE="Submit" NAME="<%= tHeaderName & "_PagingMove" %>" VALUE=" < ">
<INPUT TYPE="Submit" NAME="<%= tHeaderName & "_PagingMove" %>" VALUE=" > ">
<% If fSupportsBookmarks Then %>
<INPUT TYPE="Submit" NAME="<%= tHeaderName & "_PagingMove" %>" VALUE=" >> ">
<% End If %>
<% If Not fHideRequery Then %>
<INPUT TYPE="Submit" NAME="<% =tHeaderName & "_PagingMove" %>" VALUE=" Requery ">
<% End If %>
</FORM>
</P>
</TD>
<TD VALIGN=MIDDLE ALIGN=RIGHT>
<FONT SIZE=2>
<%
If Not fHideNumber Then
If tPageSize > 1 Then
Response.Write "<NOBR>Page: " & Session(tHeaderName & "_AbsolutePage") & "</NOBR>"
Else
Response.Write "<NOBR>Record: " & Session(tHeaderName & "_AbsolutePage") & "</NOBR>"
End If
End If
%>
</FONT>
</TD>
</TR>
</TABLE>
<%
End If
End If
%>
<!--METADATA TYPE="DesignerControl" endspan-->
<!---------------------------- Footer Section -------------------------------->
<%
' TEMP: cache here until CacheRecordset property is implemented in
' data range
If fNeedRecordset Then
Set Session("rsCorpAdminIEGroup_Recordset") = rsCorpAdminIEGroup
End If
%>
</TD></TR></TABLE>
</BODY>
</HTML>