<% '******************************************************** ' Nest o' Ad Placements, etc. ' by Gus Mueller ' November 11 1999 ' based on Jay Buangan's Shoponline layout '******************************************************** 'get the fso content intFeaturedTop=20 intPageLimit=5 intWantToShow=12 strPageName="Shoponline Blurb Editing Tool" strPreBase="\\public1\messaging\ssc\shoponline" strLabel="Top Blurb Tab Home^^^Blurb Text|Top Blurb Tab 1^^Clue 1^Blurb Text|Top Blurb Tab 2^^Clue 2^Blurb Text|Top Blurb Tab 3^^Clue 3^Blurb Text|Top Blurb Tab 4^^Clue 4^Blurb Text|Top Blurb Tab 5^^Clue 5^Blurb Text|Image^ImageURL^Href^|Left Nav Link1^LinkURL^Link Description^|Left Nav Link2^LinkURL^Link Description^|Left Nav Link3^LinkURL^Link Description^|Left Nav Link4^LinkURL^Link Description^|Left Nav Link5^LinkURL^Link Description^|Left Nav Link6^LinkURL^Link Description^|Rules^RulesText^^|Winner^name^^|Winner^name^^|Winner^name^^|Winner^name^^|Winner^name^^|Winner^name^^|Winner^name^^|Winner^name^^|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description text|Prize^link URL^image URL^description" strThisASP="admin.asp" if request("view")<>"" or request("Page")="-2" or request("delete")<>"" then bwlView=true set fso=CreateObject("scripting.filesystemobject") set filThis=fso.opentextfile(strPreBase & "/hidden.htm", 1, true) if not filThis.atendofstream then strToRead=filThis.readall end if filThis.close if strToRead<>"" then arrRead=split(strToRead, "^") strCOne=arrRead(0) strCTwo=arrRead(1) strCThree=arrRead(2) strAn=arrRead(3) end if set filThis=nothing %> <% const ONLINE_SHOPPING = 7 intSectionID = 354 intAdSectionID=354 AdQuery intSectionID, DEFAULT_SUB_SECTION_ID, true, true intTrackingLocationID = 3 '----------------------------- ' Client-Side Functions '----------------------------- Sub javascript %> <% End Sub '----------------------------- ' Main '----------------------------- Main Sub Main %> CollegeClub.com - Shop Online <% javascript %> <% colB="99cccc" intPageNum=request("page") if intPageNum="" then intPageNum=0 else if isnumeric(intPageNum) then intPageNum=cint(intPageNum) else intPageNum=0 end if end if if request("scale")<>"" and cstr(request("scale"))<>"2" then 'non-thanksgiving intScale=cint(request("scale")) intStart=1 intEnd=5 intPageLimit=5 if intScale=4 then intWantToShow=6 intStart=-3 intEnd=10 intPageLimit=5 'response.write bwlview if bwlView then intPageNum=-2 end if else if intPageNum=0 then intPageNum=1 if intscale=3 then intWantToShow=18 end if end if else 'thanksgiving intScale=2 intStart=1 intEnd=6 colB="ff9900" if intPageNum=0 then intPageNum=1 end if end if if request("e")<>"" then intscale=4 %> <%'--End TD Right Side--%>

valign="top"> <% displayTopNavigation ONLINE_SHOPPING, 0 'handle additional navigation 'response.write intPageNum if request("e")="" then response.write "" response.write "" response.write "" response.write "" 'response.write intstart for intTab=intStart to intEnd strSel="_off" colTab="99cccc" if cstr(intscale)="4" and not intTab=-1 or cstr(intscale)<>"4" then if intTab=intPageNum then strSel="_on" colTab=colB end if strTab=replace(cstr(intTab), "-", "i") 'if cstr(intscale)="4" and intTab=1 then 'response.write "" 'end if if intscale<>2 then response.write "" else response.write "" end if end if next response.write "
page " & intTab & "
" end if %>
<% 'a good place to put the flexible text situation 'response.write strCThree & " " &intPageNum & "
" if intPageNum>0 and intscale<>4 then response.write output(strCThree, intPageNum+1) elseif intPageNum=-3 and not (intscale=4 and intPageNum>-3) and request("mail")="" then 'output rules %>

Rules

<% strPath=server.mappath("/ssc/shoponline/array/" & intscale & "rules.asp") if cstr(request("page"))<>cstr(-2) then if fso.fileexists(strPath) then set filThis=fso.opentextfile(strPath, 1, true) if not filThis.atendofstream then strText=filThis.readall end if filThis.close end if end if response.write strText strText="" elseif intPageNum=-2 and not ( intscale=4 and intPageNum=-2 ) and request("mail")="" then 'output prizes %>

Prizes

<% for intNumber= 23 to 30 strURL=output(strCOne, intNumber) 'response.write strURL strImageURL=output(strCTwo, intNumber) 'response.write strImageURL 'response.write "" & output(strCThree, intNumber) & "
" response.write "" & output(strCThree, intNumber) & "

" next AdsCategoryID=0 %> Here are a few of the places you might want to go to pluck killer merchandise during your shopping spree!

<% for intThis =1 to 5 %> <% next %>
<% elseif intPageNum=-1 then 'output winners %>

Winners

Congratulations to the following winners of the Turkey Games!

<% for intNumber= 15 to 22 response.write "" & userdeal(output(strCOne, intNumber)) & "
" next %> <% elseif intPageNum=0 and request("e")="" then 'output home 'treasure hunt include if intscale<>4 then %> <% else if request("mail")="" then %> Make it easy for everyone to buy gifts for you! Create your Wish List and e-mail it off to Mom, Dad, Aunt Helen, your bother, sister - anyone!

AND... if you choose 10 or more gifts from the Wish List Catalog, you will be entered in a drawing to WIN your Wish List - up to $1,000!

It's easy: Just browse through the Wish List Catalog and check the boxes of the items you want. Add as many gifts to your Wish List as you like! Remember - you need to have at least 10 items on your list to be entered to WIN Your Wish List. When you have finished compiling your list, go to the "View My Wish List" page to submit your final list and to e-mail it to all those people struggling with what gift to get you! <% end if end if end if %>

<% strPath=UserBuild(UserIDtoAlias(user.userid)) if fso.fileexists(strPath) then set filThis=fso.opentextfile(strPath, 1) if not filThis.atendofstream then strText=filThis.readall() end if filThis.close end if if request("submit")<>"" then intTop=cint(request("top")) intBottom=cint(request("bottom")) strNuke="" strGoodies=replace(request("goodies"), ",", "|") for intrange= intBottom to intTop if inList(strGoodies, cstr(intrange))=-1 then strNuke= intRange & "|" & strNuke end if next 'response.write strNuke & "

" arrText=split(strText, "|") strText="" for intA=0 to ubound(arrText) if inList(strNuke, arrText(intA))=-1 then strText=strText & "|" & arrText(intA) else 'response.write arrText(intA) & "--kill--
" end if next strGoody=strText for each goody in request("goodies") if goody<>"" then strGoody= strGoody & "|" & goody end if next 'response.write strGoody & "***
" strPath=UserBuild(UserIDtoAlias(user.userid)) set filThis=fso.opentextfile(strPath, 2, true) arrThis=split(demultiplepipe(strGoody), "|") 'response.write vbnewline & ubound(arrThis) if ubound(arrThis)>-1 then QuickSort arrThis, 0, ubound(arrThis) strGoody=join(arrThis, "|") 'response.write strGoody & "**@@@*
" arrThis=deMultipleSortedArray(arrThis) end if strGoody=join(arrThis, "|") 'response.write strGoody & "***
" if len(strGoody)>1 then filThis.write(demultiplepipe(strGoody)) end if filThis.close end if if fso.fileexists(strPath) then set filThis=fso.opentextfile(strPath, 1) if not filThis.atendofstream then strText=filThis.readall() end if filThis.close end if if strText<>"" then if instr(strText, "|") then end if end if 'response.write strText 'display the nest of 12 ad placements strPlacements="1|2|3|4|5|6|7|8|9|10|11|12" arrPlacements=split(strPlacements, "|") AdsCategoryID=0 if request("mail")<>"" or cint(intPageNum)>0 or request("e")<>"" or (intscale=4 and intPageNum=-2) then if request("e")<>"" then intNum=decryptid(request("e")) 'response.write vbNewLine & intNum strPath=IDBuild(cstr(intNum)) set filThis=fso.opentextfile(strPath, 1, true) if not filThis.atendofstream then strThisText=filThis.readall() end if 'response.write vbNewline & strThisText filThis.close arrSuper=split(strThisText, "-") strInviter=arrSuper(1) strText=arrSuper(0) %><% if left(strText, 1)="|" then strText=right(strText, len(strText)-1) if right(strText, 1)="|" then strText=left(strText, len(strText)-1) arrView=split(strText, "|") %> <% if request("delete")<>"" then strKiller=request("killer") if strKiller<>"" then strKiller=replace(strKiller, "," , "|") 'response.write strKiller & "

" 'response.write strText strTExt= strText & "|" arrText=split(strText, "|") strNewText="" for intA=0 to ubound(arrText) 'response.write arrText(intA) if inList(strKiller, arrText(intA))=-1 then strNewText=strNewText & "|" & arrText(intA) 'response.write "!!" end if next strText=strNewText strPath=UserBuild(UserIDtoAlias(user.userid)) set filThis=fso.opentextfile(strPath, 2, true) filThis.write(demultiplepipe(deEnd(strText, "|"))) filThis.close end if arrView=split(strText, "|") end if response.write "

" intThisPage=request("thispage") intThisPage=cint(intThisPage) intButtons = (int(ubound(arrView)/(1+intPageLimit))) 'response.write intButtons for intPages=0 to intButtons if cstr(intPages)<>cstr(intThisPage) then href1= "" href2= " " else href2= "" href1= "" end if response.write href1 & "Page " & intPages+1 & href2 if intPages<>int(intButtons) then response.write " | " next response.write "

" for intPlace=0 to intPageLimit if ubound(arrview)>=intPlace + (1+intPageLimit)*intThisPage then if (arrView(intPlace + (1+intPageLimit)*intThisPage)<>"") then placead=arrView(intPlace + (1+intPageLimit)*intThisPage) if (intPlace)/3=int((intPlace)/3) then response.write vbNewLine & "

" & vbNewLine end if %> <% if (intPlace+1)/3=int((intPlace+1)/3) then response.write vbNewLine & "" & vbNewLine end if end if end if next %>
<% set rstUserID=GetRecordSet("exec sp_MyComm_GetID '"& strInviter & "'", strConnPol) if not rstUserID.eof then lngUserID=rstUserID("userid") end if set rstUserID=nothing set rstProfile=getrecordset("sp_profile_getprofile " & lngUserID, strConnPol) if not rstProfile.eof then strSender = rstProfile("firstname") & " " & rstProfile("lastname") end if set rstProfile=nothing response.write "" %> These are the items that <%=strSender%> wishes for: <% response.write "

" 'end if 'end if %>

<% ShowAd %>
<% elseif not bwlView and request("mail")="" and request("delete")="" then if intscale=4 and user.userid<>"" then response.write "" & TabText(intPageNum, intScale) & "
Checked items are already in your Wish List. To add more items, check the corresponding box and click the " & chr(34) & "Add to Wish List" & chr(34) & " button. To view all your selections, click the " & chr(34) & "View My Wish List" & chr(34) & " button." end if intFullScale=intScale*100 intsubScale=0 if intscale=3 then response.write "" intSubPage=request("subpage") if isnumeric(intsubpage) then intSubPage=cint(intsubpage) else intSubPage=0 end if intsubpagetop=int(intWantToShow/(intPageLimit+1)) intsubScale=(1+intPageLimit)*intSubPage for intSubPageaParse=0 to intsubpagetop-1 if intSubPageaParse<>intSubPage then href1="" href2="" else href1="" href2="" end if %> <%=href1%>Page <%=intSubPageaParse+1%><%=href2%> <% if intSubPageaParse<>intsubpagetop-1 then response.write (" | ") end if next response.write "" end if%> <% if user.userid<>"" or intscale<>4 then for intPlace=0 to intPageLimit if (intPlace)/3=int((intPlace)/3) then response.write vbNewLine & "" & vbNewLine end if %> <% if (intPlace+1)/3=int((intPlace+1)/3) then response.write vbNewLine & "" & vbNewLine end if next else notloggedin end if %>
<% if intSubPage=2 and intscale=3 then intFactor=48 -((intPageNum-1)*12) else intFactor=-6*(intPageNum-1) end if 'response.write intFactor placead=(cint(intPlace+1+intFullScale) + (intPageNum-1)* (intWantToShow)) + intsubScale +intFactor if intscale=4 then 'response.write placead end if if intPlace=0 then intBottom=placead end if if intPlace=intPageLimit then intTop=placead end if 'response.write placead & "
" ShowAd 'response.write placead if not(intPlace>8 and intPlace<13) then 'response.write "" & intPlace+1 end if if intscale=4 then strSel="" if inList(strText, cstr(placead))>-1 then strSel=" Checked " end if %> > <% end if %>
<% elseif request("mail")<>"" and request("submit")="" then %>

e-mail address:

Customize your Wish List E-mail:

The person who receives this e-mail will receive a link to follow which will allow them to view and purchase the items on your Wish List.

<% elseif request("mail")<>"" and request("submit")<>"" then strThisEmail=request("email") if instr(strThisEmail, "@")>0 and instr(strThisEmail, " ")<1 then strNumPAth="\\public1\messaging\ssc_array\num.txt" set filNum=fso.opentextFile(strNumPAth, 1, true) if not filNum.atendofstream then strNum=filNum.readall end if set filNum=nothing if strNum="" then intNum=0 else intNum=cint(strNum) end if intNum=intNum+1 set filNum=fso.opentextFile(strNumPAth, 2, true) filNum.write(intNum) filNum.close set filNum=nothing strAlias=UserIDtoAlias(user.userid) strPath=UserBuild(strAlias) if fso.fileexists(strPath) then set filThis=fso.opentextfile(strPath, 1) if not filThis.atendofstream then strText=filThis.readall() end if filThis.close end if strText=deEnd(strText, "|") arrText=split(strText, "|") if ubound(arrText)=>9 then set filThis=fso.opentextFile("\\public1\messaging\ssc_array\wishcontest.txt", 8, true) filThis.writeline(strAlias & "-" & strText) filThis.close set filThis=nothing strExtraText="Since your Wish List contained at least ten items, you're qualified for the drawing to WIN YOUR WISH LIST!" else strExtraText="Since your Wish List did not contain at least ten items, you're not yet qualified for the drawing to win your Wish List. But you can always create another Wish List, and if it contains ten items or more, you're qualified for the drawing." end if strPath=IDBuild(cstr(intNum)) set filThis=fso.opentextfile(strPath, 2, true) filThis.write(strText & "-" & UserIDtoAlias(user.userid)) filThis.close 'this is the URL for our flick viewer to follow back to our site strURL="http://www.collegeclub.com/ssc/d.asp?e=" & encryptid(intNum) dim strFrom dim strTo dim strSender dim strRating dim strContent set rstProfile=getrecordset("sp_profile_getprofile " & user.userid, strConnPol) if not rstProfile.eof then strSender = rstProfile("firstname") & " " & rstProfile("lastname") end if set rstProfile=nothing strTo = trim(strThisEmail) strExtra=replace(request("message"), "'", "'") strExtra=replace(strExtra, chr(34), """) strMailBody="" strMailBody = strMailBody & "Re: " & strSender & "'s Wish List" & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & strSender & " has created a Wish List at CollegeClub. What's a wish" & vbNewLine strMailBody = strMailBody & "list? It's just what you think - a list of items " & strSender & " chose" & vbNewLine strMailBody = strMailBody & "and would love to receive as gifts! AND, because " & strSender & " is a" & vbNewLine strMailBody = strMailBody & "student, YOU are able to receive exclusive student pricing for all these" & vbNewLine strMailBody = strMailBody & "holiday gifts. " & strSender & " asked that we send you this message to let" & vbNewLine strMailBody = strMailBody & "you know!" & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & "Click on the following link to view " & strSender & "'s Wish List:" & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & strURL & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & "If you're not able to click on this link, please e-mail us at" & vbNewLine strMailBody = strMailBody & "wishlist@collegeclub.com ." & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & "We hope this helps you as you shop this holiday for " & strSender & "." & vbNewLine strMailBody = strMailBody & vbNewLine if strExtra<>"" then strMailBody = strMailBody & "Additionally, " & strSender & " sent the following message:" & vbNewLine strMailBody = strMailBody & strExtra & vbNewLine strMailBody = strMailBody & vbNewLine end if strMailBody = strMailBody & "Best Wishes," & vbNewLine strMailBody = strMailBody & vbNewLine strMailBody = strMailBody & "Your friends at CollegeClub.com" & vbNewLine strFrom = trim(useridtoalias(user.userid) & "@collegeclub.com") Set objNewMail = CreateObject("CDONTS.NewMail") objNewMail.Send strFrom, strTo,strSender & "'s Wish List", strMailBody, 0 Set objNewMail = Nothing 'iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii response.write ("

Your Wish List has been sent!

" & strExtraText) else response.write ("

You didn't specify any recipients!

back

") end if elseif (request("mail") ="" and bwlView) or request("delete")<>"" then %> <% strText=deEnd(strText, "|") arrView=split(strText, "|") %> <% if request("delete")<>"" then strKiller=request("killer") if strKiller<>"" then strKiller=replace(strKiller, "," , "|") 'response.write strKiller & "

" 'response.write strText strTExt= strText & "|" arrText=split(strText, "|") strNewText="" for intA=0 to ubound(arrText) 'response.write arrText(intA) if inList(strKiller, arrText(intA))=-1 then strNewText=strNewText & "|" & arrText(intA) 'response.write "!!" end if next strText=strNewText strPath=UserBuild(UserIDtoAlias(user.userid)) set filThis=fso.opentextfile(strPath, 2, true) filThis.write(demultiplepipe(strText) ) filThis.close end if strText=deEnd(strText, "|") arrView=split(strText, "|") end if if user.userid<>"" then response.write "

" intThisPage=request("thispage") intThisPage=cint(intThisPage) intButtons = (int(ubound(arrView)/(1+intPageLimit))) 'response.write intButtons for intPages=0 to intButtons if cstr(intPages)<>cstr(intThisPage) then href1= "" href2= " " else href2= "" href1= "" end if response.write href1 & "Page " & intPages+1 & href2 if intPages<>int(intButtons) then response.write " | " next response.write "

" %><% intViewOut=0 for intPlace=0 to intPageLimit if intPlace+(1+intPageLimit)*intThisPage<=ubound(arrView) then if (arrView(intPlace+(1+intPageLimit)*intThisPage)<>"") then placead=arrView(intPlace+(1+intPageLimit)*intThisPage) 'response.write placead & " " & intPlace+(1+intPageLimit)*intThisPage if (intPlace)/3=int((intPlace)/3) then response.write vbNewLine & "

" & vbNewLine end if %> <% if (intPlace+1)/3=int((intPlace+1)/3) then response.write vbNewLine & "" & vbNewLine end if end if end if next else notloggedin end if %>
<%if strText<>"" and user.userid<>"" then %> These are the items on your Wish List.
To remove items from this list, click on the checkbox and click the "Delete Selected" button.

To E-mail this Wish List to someone, click the "E-mail Your Wish List" button. <%elseif user.userid<>"" then%> You do not yet have anything in your Wish List.
To add items to this list, browse the items on the numbered tabs and follow the instructions on those pages. <%end if%>

<% if isnumeric(placead) then placead=cint(placead) ShowAd intViewOut=intViewOut+1 %>

  <% else placead=0 end if %>

<% end if end if if intBottom="" then intBottom=0 if intTop="" then intTop=0 if user.userid<>"" and intScale=4 and request("e")="" then%> <%if not bwlView and request("delete")="" then%> <%if request("mail")="" and request("email")="" then%> <%end if%> <%if request("mail")="" and intPageNum>0 then%> <%end if%> <%elseif request("mail")="" and intViewOut>0 then%> <%end if%> " type="hidden"> " type="hidden"> <%end if%>

<% set filThis=nothing set fso=nothing End Sub function inList(strList, strPossibleBad) 'returns the location of strPossibleBad within the |-delimited list of strList dim intParseBan, strPossibleBan, arrBan inList=-1 intParseBan=0 if strList<>"" then if instr(strList, "|") then arrBan=split(strList, "|") do until intParseBan > ubound(arrBan) or inList>-1 strPossibleBan=trim(arrBan(intParseBan)) if strPossibleBan<>"" then if lcase(strPossibleBan) = lcase(strPossibleBad) then inList=intParseBan end if end if intParseBan=intParseBan+1 loop else if strPossibleBad<>"" then if lcase(strPossibleBad)=lcase(strList) then inList=0 end if end if end if end function function Nice(byval strIn) if strIn<>"" then strIn=replace(strIn, "|", " ") strIn=replace(strIn, "^", " ") strIn=replace(strIn, vbNewLine, "
") end if Nice=strIn end function function present(byval strIn) strIn=replace(strIn, "
", vbNewline) present=strIn end function function outPut(byval strIn, byval intnumber) dim arrTemp, strOut if strIn<>"" then arrTemp=split(strIn, "|") if isarray(arrTemp) then if intnumber<= ubound(arrTemp) then strOut=arrTemp(intnumber) else strOut="" end if else strOut="" end if else strOut="" end if outPut=strOut end function function userdeal(byval strIn) dim rstUserID, strPreHref, strPostHref, intUserID strIn=trim(strIn) if instr(strIn, " ")<1 then if strIn<>"" then set rstUserID=GetRecordSet("exec sp_MyComm_GetID '"& strIn & "'", strConnPol) if not rstUserID.eof then intUserID=rstUserID("userid") strPreHref="" strPostHref="" else strPreHref="" strPostHref="" end if userdeal=strPreHref & strIn & strPostHref '& ShowHere(intUserID) end if else userdeal=strIn end if end function function ShowHere(byval intUserID) if intUserID<>"" then if isonline(intUserID) then ShowHere= "*" end if end if end function function IDBuild(byval strIDin) dim strIDChar, folNew, strFolderAccumlate, strWhatBase, intParse strWhatBase="\\public1\messaging\ssc_array\invites" strFolderAccumlate="" strIDin=cstr(strIDin) for intParse=1 to len(strIDin)-1 strIDChar=mid(strIDin, intParse, 1) if not fso.folderexists(strWhatBase & strFolderAccumlate & "\" & strIDChar) then set folNew=fso.createfolder(strWhatBase & strFolderAccumlate & "\" & strIDChar) end if strFolderAccumlate = strFolderAccumlate & "\" & strIDChar next IDBuild=strWhatBase & strFolderAccumlate & "\" & strIDin & ".txt" end function function UserBuild(byval strIDin) dim strIDChar, folNew, strFolderAccumlate, strWhatBase, intParse strWhatBase="\\public1\messaging\ssc_array\users" strFolderAccumlate="" strIDin=cstr(strIDin) for intParse=1 to len(strIDin)-1 strIDChar=mid(strIDin, intParse, 1) if not fso.folderexists(strWhatBase & strFolderAccumlate & "\" & strIDChar) then set folNew=fso.createfolder(strWhatBase & strFolderAccumlate & "\" & strIDChar) end if strFolderAccumlate = strFolderAccumlate & "\" & strIDChar next UserBuild=strWhatBase & strFolderAccumlate & "\" & strIDin & ".txt" end function function UserIDToAlias(UserID) if UserId = "" then exit function dim rstUser set rstUser = GetRecordSet("sp_User_UserIDToAlias " & UserID,strConnPol) if not rstUser.eof then UserIDToAlias = rstUser("Alias") end if set rstUser = nothing end function function DeMultiple(byval strIn, byval strCharIn) if strIn<>"" then DeMultiple=strIn do while instr(DeMultiple, strCharIn & strCharIn) DeMultiple=replace(DeMultiple, strCharIn & strCharIn, strCharIn) loop else DeMultiple="" end if end Function function demultiplepipe(byval strIn) strIn=DeMultiple(strIn, "|") demultiplepipe=strIn end function sub QuickSort(arrIn, l, r) dim i dim j dim X dim Y i = l j = r X = arrIn((l + r) / 2) while (i <= j) while (arrIn(i) < X and i < r) i = i + 1 wend while (X < arrIn(j) and j > l) j = j - 1 wend if (i <= j) Then Y = arrIn(i) arrIn(i) = arrIn(j) arrIn(j) = Y i = i + 1 j = j - 1 end If wend if (l < j) then QuickSort arrIn, l, j if (i < r) then QuickSort arrIn, i, r end sub function deMultipleSortedArray(arrIn) if ubound(arrIn)>-1 then dim arrOut redim arrOut(ubound(arrIn)) if ubound(arrIn)-1 > 0 then for t=0 to ubound(arrIn)-1 if arrIn(t)=arrIn(t+1) then arrOut(t)="" else arrOut(t)=arrIn(t) end if next end if arrOut(ubound(arrIn))=arrIn(ubound(arrIn)) end if deMultipleSortedArray=arrOut end function function TabText(byval intIn, byval intScale) if user.userid<>"" then dim strOut select case intScale case 4 strTabs="|Entertainment/Music|Software/Hardware|Misc.|Health Beauty/Apparrel|Electronics||||||||" end select if strTabs<>"" then if instr(strTabs, "|") then arrTabs=split(strTabs, "|") if intIn<=ubound(arrTabs) then strOut=arrTabs(int((1+intIn)/2)) end if end if end if end if TabText=strOut end function function deEnd(byval strIn, byval strChr) if left(strIn, 1)=strChr then strIn=right(strIn, len(strIn)-1) if right(strIn, 1)=strChr then strIn=left(strIn, len(strIn)-1) deEnd=strIn end function sub notloggedin %>

 

You must be a registered user to create a wish list.

Log In      Become a member! <% end sub %>