<%
'*******************************************************************************
'* XcAuction Copyright 1995-2003 XCENT - www.xcent.com *
'* XcAuction is a trademark of XCENT *
'* This notice may not be removed from this source code file *
'*******************************************************************************
Dim lCategories, lCategory
'Redim vCategories(0)
Dim bIconCol()
ReDim bIconCol(giMainCategoryCols)
Dim sArSpecialIcons
lCategories = 0
If giAuctionEnabled Then
OpenDBConn
If NOT (gbRegistrationRequired AND NOT IsUserLoggedIn) Then
DoPageHeader
AddJavaScriptHelp
TableHead
If gbShowCatsOnMain Then 'If Enabled Show Categories
sSQL = "SELECT catID, catIcon, catDescription, catCount FROM tblAPCategories " & _
"WHERE catParentID IS NULL " & _
"AND (catEnable = " & SQLBool("Y") & " OR catCount > " & SQLVal(0) & ") " & _
"ORDER BY catSysOrder"
Set rsTopCat = gobjConnect.Execute(sSQL)
Response.Write ""
If rsTopCat.Eof Then
Response.Write "| " & gsPlainTextOpen & GLS_TextNoCategories & gsPlainTextClose & " |
"
Else
vCategories = rsTopCat.GetRows 'adGetRowsRest
lCategories = UBound(vCategories,2) + 1
End If
rsTopCat.Close
Set rsTopCat = Nothing
sColWidth = Cint(100 \ giMainCategoryCols) & "%"
lRows = Cint(lCategories / giMainCategoryCols)
If (lCategories / giMainCategoryCols) > lRows Then lRows = lRows + 1
For lRow = 1 to lRows
For lColumn = 1 to giMainCategoryCols
lIndex = lRow + ((lColumn-1) * lRows) - 1
If lIndex <= lCategories - 1 Then
If Len(vCategories(1, lIndex)) > 0 Then
bIconCol(lColumn) = True
End If
End If
Next
Next
For lRow = 1 to lRows
For lColumn = 1 to giMainCategoryCols
lIndex = lRow + ((lColumn-1) * lRows) - 1
If lColumn = 1 Then Response.Write ""
If lIndex <= lCategories -1 Then
If Len(vCategories(1, lIndex)) > 0 Then
Response.Write ""
Response.Write "![]() | "
ElseIf bIconCol(lColumn) Then
Response.Write " | "
End If
Response.Write "" & gsMainCatTagOpen
Response.Write "" & vCategories(2, lIndex) & ""
If gbShowMainCount = True Then Response.Write " (" & vCategories(3, lIndex) & ")"
Response.Write gsMainCatTagClose
If gbDefShowSub Then GetSubCategories(FVal(vCategories(0, lIndex)))
Response.Write " | "
Else
If bIconCol(lColumn) Then Response.Write " | "
Response.Write " | "
End If
If lColumn = giMainCategoryCols Then Response.Write "
"
Next
Next
Response.Write "
"
Response.Write " "
Else
'*** Do not show categories ***
End If 'Show Categories
'*** Premiere ***
If EvalBool(gbDefShowItems) And ((gbUseFeatured And UCase(gsDefItemType) = "F") Or (gbUsePremiere And UCase(gsDefItemType) = "P")) Then
Response.Write ""
Response.Write "| " & gsDefaultFeatTabTextOpen & OutMatch(True, UCase(gsDefItemType) = "F", GLS_DefFeatText, GLS_DefPremiereText) & gsDefaultFeatTabTextClose & " | "
Response.Write " |
"
Response.Write "![]() |
"
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
If gsDefDisplay = "L" Then
DisplayPremiereListView
Else
DisplayPremiereThumbView
End If
Response.Write " "
Response.Write " | "
Response.Write " "
Response.Write " |
"
Response.Write "
"
Response.Write " "
End If
TableFoot
DoPageFooter
Else
Response.Redirect "APRegistrationRequired.asp"
End If
CloseDBConn
Else
Response.Redirect "APDisabled.asp"
End If
Sub DisplayPremiereListView
If giDBType = 1 Then
sSQL = "SELECT TOP " & giDefItems & " "
Else
sSQL = "SELECT "
End If
sSQL = sSQL & "aucID, aucAvailable, aucClose, aucTitle, aucStartingBid, aucCurrentBid, aucShowBold, " & _
"aucIconName, aucShowFeatured, aucShowInGallery, aucShowInPremiere, aucType, aucThumbnail " & _
"FROM tblAPAuctions " & _
"WHERE aucStaged = " & SQLBool(False)
If gbDefDisplayRandom Then
sFeaturedIDs = PopFeaturedAuctions(giDefItems)
If Len(sFeaturedIDs) > 0 Then
sArFeaturedIDs = Split(sFeaturedIDs, " ")
sSQL = sSQL & " AND aucID IN ("
bFirst = True
For iIndex = 0 To UBound(sArFeaturedIDs)
If Len(sArFeaturedIDs(iIndex)) > 0 Then
If bFirst Then
sSQL = sSQL & sArFeaturedIDs(iIndex)
bFirst = False
Else
sSQL = sSQL & ", " & sArFeaturedIDs(iIndex)
End If
End If
Next
sSQL = sSQL & ")"
End If
End If
sSQL = sSQL & " AND aucClose > " & SQLDate(NOW) & _
" AND " & OutMatch(True, gsDefItemType = "F", "aucShowFeatured", "aucShowInPremiere") & " = " & SQLStr("Y") & _
" ORDER BY aucClose "
'Response.Write "" & sSQL & ""
Set rsFeatured = Server.CreateObject("ADODB.Recordset")
rsFeatured.PageSize = giDefItems
rsFeatured.CursorLocation = 3 'adUseClient
rsFeatured.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText
iCols = 2
Response.Write ""
If gbDefShowAucType Then
Response.Write "| " & gsColTitleOpen & GLS_DefPremAucTypeHeaderTitle & gsColTitleClose & " | "
iCols = iCols + 1
End If
If gbDefShowBonusIcons Then
Response.Write "" & gsColTitleOpen & GLS_DefPremBonusHeaderTitle & gsColTitleClose & " | "
iCols = iCols + 1
End If
If gbDefShowThumbs Then
Response.Write " | "
iCols = iCols + 1
End If
Response.Write "" & gsColTitleOpen & GLS_DefPremItemHeaderTitle & gsColTitleClose & " | "
Response.Write "" & gsColTitleOpen & GLS_DefPremCurrBidHeaderTitle & gsColTitleClose & " | "
Response.Write "
"
If Not rsFeatured.EOF Then
If gbDefShowBonusIcons Then
OpenSpecialIconArray
End If
x = 0
Do While (not rsFeatured.EOF) AND (rsFeatured.AbsolutePage=1)
lAucID = FVal(rsFeatured("aucID"))
bBold = EvalBool(rsFeatured("aucShowBold"))
sTitle = "" & rsFeatured("aucTitle")
fCurrentBid = FVal(rsFeatured("aucCurrentBid"))
fStartingBid = FVal(rsFeatured("aucStartingBid"))
lIconID = FVal(rsFeatured("aucIconName"))
bFeatured = EvalBool(rsFeatured("aucShowFeatured"))
bPremiere = EvalBool(rsFeatured("aucShowInPremiere"))
bGallery = EvalBool(rsFeatured("aucShowInGallery"))
sAucType = "" & rsFeatured("aucType")
sThumbnail = "" & rsFeatured("aucThumbnail")
x = x + 1
Response.Write ""
If gbDefShowAucType Then
Response.Write "| " & AuctionTypeIcon(sAucType) & " | "
End If
If gbDefShowBonusIcons Then
Response.Write ""
'Gallery
If gbGalleryView And gbUseGallery And bGallery Then
Response.Write "![]() "
End If
'Featured
If bFeatured And gsDefItemType = "P" Then
Response.Write "![]() "
End If
'Premiere
If bPremiere And gsDefItemType = "F" Then
Response.Write "![]() "
End If
'Icon
If lIconID > 0 And gbShowIcons Then
Response.Write OutputIcon(lIconID)
Else
Response.Write "![]() "
End If
Response.Write " | "
End If
If gbDefShowThumbs Then
Response.Write ""
If Len(sThumbnail) Then
Response.Write "![]() "
Else
Response.Write " "
End If
Response.Write " | "
End If
Response.Write "" & gsAuctionListingOpen
If bBold And gbDefShowBold Then Response.Write " "
Response.Write ""
Response.Write sTitle & "" & gsAuctionListingClose
If bBold And gbDefShowBold Then Response.Write ""
Response.Write " | "
Response.Write "" & gsAuctionListingOpen
If fCurrentBid = 0 Then
Response.Write DispCurrency(fStartingBid)
Else
Response.Write DispCurrency(fCurrentBid)
End If
Response.Write gsAuctionListingClose & " | "
Response.Write "
"
rsFeatured.MoveNext
Loop
Else
'Response.Write "| " & gsPlainTextOpen & GLS_TextNoAuctionsListed & gsPlainTextClose & " |
"
Response.Write "| " & gsPlainTextOpen
ShowHTMLFile(Server.MapPath("APHtmlTxt/APNoPremierFeatured.htm"))
Response.Write gsPlainTextClose & " |
"
End If
rsFeatured.Close
Set rsFeatured = Nothing
End Sub
Sub DisplayPremiereThumbView
Dim sThumbRow, sTitleRow, sCloseRow
If giDBType = 1 Then
sSQL = "SELECT TOP " & giDefItems & " "
Else
sSQL = "SELECT "
End If
sSQL = sSQL & "aucID, aucAvailable, aucClose, aucTitle, aucStartingBid, aucCurrentBid, aucShowBold, " & _
"aucIconName, aucShowFeatured, aucShowInGallery, aucShowInPremiere, aucType, aucThumbnail " & _
"FROM tblAPAuctions " & _
"WHERE aucStaged = " & SQLBool(False)
If gbDefDisplayRandom Then
sFeaturedIDs = PopFeaturedAuctions(giDefItems)
If Len(sFeaturedIDs) > 0 Then
sArFeaturedIDs = Split(sFeaturedIDs, " ")
sSQL = sSQL & " AND aucID IN ("
bFirst = True
For iIndex = 0 To UBound(sArFeaturedIDs)
If Len(sArFeaturedIDs(iIndex)) > 0 Then
If bFirst Then
sSQL = sSQL & sArFeaturedIDs(iIndex)
bFirst = False
Else
sSQL = sSQL & ", " & sArFeaturedIDs(iIndex)
End If
End If
Next
sSQL = sSQL & ")"
End If
End If
sSQL = sSQL & " AND aucClose > " & SQLDate(NOW) & _
" AND " & OutMatch(True, gsDefItemType = "F", "aucShowFeatured", "aucShowInPremiere") & " = " & SQLStr("Y") & _
" ORDER BY aucClose "
'Response.Write "" & sSQL & ""
Set rsFeatured = Server.CreateObject("ADODB.Recordset")
rsFeatured.PageSize = giDefItems
rsFeatured.CursorLocation = 3 'adUseClient
rsFeatured.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText
If Not rsFeatured.EOF Then
iCurrentCol = 1
iNumCols = giDefThumbCols
iColWidth = CLng((1 / iNumCols) * 100)
bFirstIteration = True
Do While (not rsFeatured.EOF) AND (rsFeatured.AbsolutePage=1)
lAucID = FVal(rsFeatured("aucID"))
bBold = EvalBool(rsFeatured("aucShowBold"))
sTitle = "" & rsFeatured("aucTitle")
fCurrentBid = FVal(rsFeatured("aucCurrentBid"))
fStartingBid = FVal(rsFeatured("aucStartingBid"))
vAucClose = FDate(rsFeatured("aucClose"))
sThumbnail = "" & rsFeatured("aucThumbnail")
If bFirstIteration Then
Response.Write "| |
"
bFirstIteration = False
End If
If iCurrentCol = 1 Then
sThumbRow = vbCrLf & ""
sTitleRow = vbCrLf & "
"
sCloseRow = vbCrLf & "
"
End If
'Thumbnail Row Construction
sThumbRow = sThumbRow & ""
If Len(sThumbnail) Then
sThumbRow = sThumbRow & "![]() "
Else
sThumbRow = sThumbRow & "![]() "
End If
sThumbRow = sThumbRow & " | " & vbCrLf
'Title Row Construction
sTitleRow = sTitleRow & "" & gsAuctionListingOpen
If bBold And gbDefShowBold Then sTitleRow = sTitleRow & " "
sTitleRow = sTitleRow & "" & sTitle & "" & gsAuctionListingClose
If bBold And gbDefShowBold Then sTitleRow = sTitleRow & ""
sTitleRow = sTitleRow & " | " & vbCrLf
'Close Row Construction
sCloseRow = sCloseRow & "" & gsPlainTextOpen & "" & GLS_DefPremTimeLeftText & "" & GetTimeLeft(vAucClose) & "" & gsPlainTextClose & " | " & vbCrLf
If iCurrentCol = iNumCols Then
sThumbRow = sThumbRow & "
"
sTitleRow = sTitleRow & ""
sCloseRow = sCloseRow & ""
Response.Write sThumbRow & vbCrLf
Response.Write sTitleRow & vbCrLf
Response.Write sCloseRow & vbCrLf
Response.Write "| |
"
iCurrentCol = 1
Else
iCurrentCol = iCurrentCol + 1
End If
rsFeatured.MoveNext
Loop
If (iCurrentCol - 1 < iNumCols) And (iCurrentCol > 1) Then
For iIndex = iCurrentCol To iNumCols
sThumbRow = sThumbRow & " | "
sTitleRow = sTitleRow & " | "
sCloseRow = sCloseRow & " | "
Next
sThumbRow = sThumbRow & ""
sTitleRow = sTitleRow & ""
sCloseRow = sCloseRow & ""
Response.Write sThumbRow & vbCrLf
Response.Write sTitleRow & vbCrLf
Response.Write sCloseRow & vbCrLf
Response.Write "| |
"
End If
Else
'Response.Write "| " & gsPlainTextOpen & GLS_TextNoAuctionsListed & gsPlainTextClose & " |
"
Response.Write "| " & gsPlainTextOpen
ShowHTMLFile(Server.MapPath("APHtmlTxt/APNoPremierFeatured.htm"))
Response.Write gsPlainTextClose & " |
"
End If
rsFeatured.Close
Set rsFeatured = Nothing
End Sub
Function GetTimeLeft(pvDate)
Dim iDays, iHours, iMins, iSecs
iDays = 0
iHours = 0
iMins = 0
iSecs = 0
CISecPerDay = 86400
CISecPerHour = 3600
CISecPerMin = 60
lTotalSecs = DateDiff("s", Now, pvDate)
If (lTotalSecs >= CISecPerDay) Then
iDays = (lTotalSecs \ CISecPerDay)
lTotalSecs = lTotalSecs - (iDays * CISecPerDay)
End If
If (lTotalSecs >= CISecPerHour) Then
iHours = (lTotalSecs \ CISecPerHour)
lTotalSecs = lTotalSecs - (iHours * CISecPerHour)
End If
If (lTotalSecs >= CISecPerMin) Then
iMins = (lTotalSecs \ CISecPerMin)
lTotalSecs = lTotalSecs - (iMins * CISecPerMin)
End If
iSecs = lTotalSecs
sTimeLeftString = ""
bRemainder = False
If iDays > 0 Then
sTimeLeftString = sTimeLeftString & iDays & GLS_TimerDays & " "
bRemainder = True
End If
If iHours > 0 OR bRemainder Then
sTimeLeftString = sTimeLeftString & iHours & GLS_TimerHours & " "
bRemainder = True
End If
If iMins > 0 OR bRemainder Then
sTimeLeftString = sTimeLeftString & iMins & GLS_TimerMinutes & " "
bRemainder = True
End If
If iSecs > 0 OR bRemainder Then
sTimeLeftString = sTimeLeftString & iSecs & GLS_TimerSeconds
End If
GetTimeLeft = sTimeLeftString
End Function
Sub TableFoot
If gbShowNavBarOnMain Then
ShowNavBar False,0
End If
End Sub
Sub TableHead
'**Stats
If gbDefShowStats Then
LoadStats
sStatsInfo = Application("aucStatsTemplate")
sStatsInfo = Replace(sStatsInfo, "%AUCSTATSDATE%", DispShortDate(gvAucStatsDate))
sStatsInfo = Replace(sStatsInfo, "%AUCSTATSCOUNT%", glAucStatsCount)
sStatsInfo = Replace(sStatsInfo, "%AUCSTATSBIDS%", glAucStatsBids)
sStatsInfo = Replace(sStatsInfo, "%GENERALSTATSUSERS%", glGeneralStatsUsers)
Else
sStatsInfo = " "
End If
'**Search Form
If gbShowSearchOnMain Then
sSearchInfo = DoSearchForm(0)
Else
sSearchInfo = " "
End If
Response.Write ""
Response.Write "| " & sStatsInfo & " | "
Response.Write "" & sSearchInfo & " |
"
Response.Write "| |
"
Response.Write "
"
'**Header
Response.Write ""
Response.Write "| " & gsTabTextOpen & gsDefAucHomeTab & gsTabTextClose & " | "
Response.Write "" & gsPlainTextOpen & ""
Response.Write " " & gsPlainTextClose & " |
"
Response.Write "![]() |
"
Response.Write "
"
End Sub
Sub GetSubCategories(piMainCatID)
sSQL = "SELECT catID, catDescription FROM tblAPCategories " & _
"WHERE catParentID = " & SQLVal(piMainCatID) & " " & _
"AND (catEnable = " & SQLBool("Y") & " OR catCount > " & SQLVal(0) & ") " & _
"ORDER BY catSysOrder"
Set rsSubCat = gobjConnect.Execute(sSQL)
If Not rsSubCat.Eof Then
Response.Write gsMainCatSubOpen
iSubCatCount = 0
Do While Not rsSubCat.Eof
If (giMainCategoryNumSubCats > 0) Then
If (iSubCatCount < giMainCategoryNumSubCats) Then
Response.Write "" & rsSubCat("catDescription") & ""
rsSubCat.MoveNext
If Not rsSubCat.Eof AND (iSubCatCount < giMainCategoryNumSubCats - 1) Then
Response.Write ", "
Else
If Not rsSubCat.Eof Then
Response.Write " ..."
End If
End If
iSubCatCount = iSubCatCount + 1
Else
rsSubCat.MoveNext
End If
Else
Response.Write "" & rsSubCat("catDescription") & ""
rsSubCat.MoveNext
If Not rsSubCat.Eof Then
Response.Write ", "
End If
End If
Loop
Response.Write gsMainCatSubClose
End If
rsSubCat.Close
Set rsSubCat = Nothing
End Sub
Function PopFeaturedAuctions(plNumAucs)
Dim sAucIDs, sFeaturedAucIDs, iIndex, iTempIndex, bFirst, sArFeaturedIDs
Dim bDebug
bDebug = False
sFeaturedAucIDs = Application("aucFeaturedAucIDs")
If Len(sFeaturedAucIDs) = 0 Then
PopulateFeaturedItemCache
sFeaturedAucIDs = Application("aucFeaturedAucIDs")
End If
If Len(sFeaturedAucIDs) > 0 Then
If bDebug Then Response.Write "Got the ID string now get them into an array" & sFeaturedAucIDs & "
"
sArFeaturedIDs = Split(sFeaturedAucIDs, " ")
bFirst = True
'For iIndex = 0 To plNumAucs - 1
iIndex = 0
iCount = 0
Do While iCount <= plNumAucs - 1
If iIndex <= UBound(sArFeaturedIDs) Then
If bDebug Then Response.Write "Get an auc ID
"
If bFirst Then
sAucIDs = sAucIDs & "" & sArFeaturedIDs(iIndex)
bFirst = False
Else
sAucIDs = sAucIDs & " " & sArFeaturedIDs(iIndex)
End If
iIndex = iIndex + 1
iCount = iCount + 1
Else
If bDebug Then Response.Write "Populate the cache within the loop
"
PopulateFeaturedItemCache
sFeaturedAucIDs = Application("aucFeaturedAucIDs")
If Len(sFeaturedAucIDs) > 0 Then
ReDim sArFeaturedIDs(0)
sArFeaturedIDs = Split(sFeaturedAucIDs, " ")
iIndex = 0
Else
Exit Do
End If
End If
If bDebug Then Response.Write "In The Pop Loop
"
Loop
'Next
sTempFeaturedIDs = ""
bFirst = True
For iTempIndex = iIndex To UBound(sArFeaturedIDs)
If bFirst Then
sTempFeaturedIDs = sTempFeaturedIDs & "" & sArFeaturedIDs(iTempIndex)
bFirst = False
Else
sTempFeaturedIDs = sTempFeaturedIDs & " " & sArFeaturedIDs(iTempIndex)
End If
Next
Application.Lock
Application("aucFeaturedAucIDs") = sTempFeaturedIDs
Application.Unlock
End If
PopFeaturedAuctions = sAucIDs
End Function
Sub PopulateFeaturedItemCache
Dim bDebug
bDebug = False
If bDebug Then Response.Write "Populating the Cache
"
Dim sFeaturedIDs, bFirst, sSQL
sFeaturedIDs = ""
sSQL = "SELECT TOP 100 " & _
" aucID FROM tblAPAuctions " & _
" WHERE " & OutMatch(True, gsDefItemType = "F", "aucShowFeatured", "aucShowInPremiere") & " = " & SQLStr("Y") & _
" AND aucClose > " & SQLDate(NOW) & _
" AND NOT aucStaged = " & SQLStr("Y") & _
" ORDER BY aucClose "
If bDebug Then Response.Write "" & sSQL & ""
Set rsFeatured = Server.CreateObject("ADODB.Recordset")
rsFeatured.CursorLocation = 3 'adUseClient
rsFeatured.Open sSQL, gobjConnect, 3, 1, &H0001 'adOpenStatic, adLockReadOnly, adCmdText
If Not rsFeatured.EOF Then
bFirst = True
Do While Not rsFeatured.EOF
If bFirst Then
sFeaturedIDs = sFeaturedIDs & "" & rsFeatured("aucID")
If bDebug Then Response.Write "First one
"
bFirst = False
Else
sFeaturedIDs = sFeaturedIDs & " " & rsFeatured("aucID")
End If
rsFeatured.MoveNext
Loop
Else
If bDebug Then Response.Write "Nothing to put in there"
End If
rsFeatured.Close
Set rsFeatured = Nothing
Application.Lock
Application("aucFeaturedAucIDs") = sFeaturedIDs
Application.UnLock
End Sub
Sub OpenSpecialIconArray
sSQLIcons = "SELECT * FROM tblAPIcons"
Set rsIcons = Server.CreateObject("ADODB.Recordset")
rsIcons.Open sSQLIcons, gobjConnect, 3, 2, &H0001 'adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsIcons.EOF THen
sArSpecialIcons = rsIcons.GetRows
End If
rsIcons.Close
Set rsIcons = Nothing
End Sub
Function OutputIcon(plIconID)
Dim sIcon
sIcon = ""
If IsArray(sArSpecialIcons) Then
For iIndex = 0 To UBound(sArSpecialIcons, 2)
If sArSpecialIcons(0, iIndex) = plIconID Then
sIcon = "![]()
"
End If
Next
End If
OutputIcon = sIcon
End Function
%>