<% listNumber = 0 ' Change this to the sublist number - leave zero for master list Dim frmAcct, control Dim goodAcct, html, weekend, dayend, goodTemp ReDim goodAcct(1000,5) ReDim html(nRanked(listNumber) / perPage(listNumber) + 1) If Request("action") = "create" then adminPass = readFile(pathData & "password.cgi") If adminPass <> Request("password") then Response.Write "

Security Violation

" Response.End Else done = create() End If End If frmAcct = Request("acct") If frmAcct = "" then goHome() End If acctFile = pathData & frmAcct & ".act" dx = readFile(acctFile) If dx = "" then goHome() Else dx = dx & vbCrLf userArray = Split(dx, vbCrLf) userLine1 = Split(userArray(0), Chr(44)) If userLine1(listNumber) = "-1" then goHome() Else userLine2 = Split(userArray(1), Chr(44)) userLine3 = Split(userArray(2), Chr(44)) ipAddr = Request.ServerVariables("REMOTE_ADDR") newTime = now - (ipTimeOut / 1440) Dim lastHit, newArray For i = 3 to UBound(userArray) lastHit = Split(userArray(i), Chr(44)) ReDim Preserve lastHit(1) If lastHit(1) <> "" then If CDate(lastHit(1)) > CDate(newTime) then newArray = newArray & userArray(i) & vbCrLf End If End If Next If InStr(newArray, ipAddr) then goHome() End If ' Successful Hit - Count and Write new activity file newHit = CInt(userLine1(listNumber)) + 1 weekHit = CInt(userline2(listNumber)) + 1 totHit = CLng(userline3(listNumber)) + 1 userLine1(listNumber) = CStr(newHit) userLine2(listNumber) = CStr(weekHit) userLine3(listNumber) = CStr(totHit) If listNumber > 0 then newHit = CInt(userLine1(0)) + 1 weekHit = CInt(userLine2(0)) + 1 totHit = CLng(userLine3(0)) + 1 userLine1(0) = CStr(newHit) userLine2(0) = CStr(weekHit) userLine3(0) = CStr(totHit) End If newLine = Join(userLine1, chr(44)) newLine2 = Join(userLine2, chr(44)) newLine3 = Join(userLine3, chr(44)) newArray = newLine & vbCrLf & newLine2 & vbCrLf & newLine3 & vbCrLf & newArray & ipAddr & chr(44) & now & vbCrLf done = writeFile(acctFile, newArray) timeFile = pathData & "time" & CStr(listNumber) & ".dat" strTime = readFile(timeFile) If CDate(strTime) < (now - (createTime / 1440)) then done = writeFile(timeFile, now) If Day(now) > Day(strTime) and Weekday(now) = 2 then weekend = 1 ElseIf Month(now) > Month(strTime) And Weekday(now) = 2 then weekend = 1 ElseIf Day(now) > Day(strTime) Or Month(now) > Month(strTime) then dayend = 1 End If create() Else goHome() End If End If End If Function goHome() Response.Redirect listUrl(listNumber) End Function Function writeFile(fileName, fileData) Dim fso, ts Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(fileName, 2, True) ts.Write fileData ts.Close Set ts = Nothing Set fso = Nothing End Function Function readFile(fileName) On Error Resume Next Dim fso, ts Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(fileName, 1) allFile = ts.ReadAll ts.Close readFile = allFile Set ts = Nothing Set fso = Nothing End Function Function resetWeek() mbrFile = readFile(pathData & "members.dat") acctName = Split(mbrFile, vbCrLf) For i = 0 to UBound(acctName) actFile = pathData & acctName(i) & ".act" thisAcctAct = readFile(actFile) fileLine = Split(thisAcctAct, vbCrLf) ReDim Preserve fileLine(20) If fileLine(0) <> "" then line1 = Split(fileLine(0), chr(44)) If line1(listNumber) <> "-1" then line2 = Split(fileLine(1), chr(44)) line1(listNumber) = "0" line1(nLists + listNumber + 1) = "0" line2(listNumber) = "0" line2(nLists + listNumber + 1) = "0" newline1 = Join(line1, chr(44)) newline2 = Join(line2, chr(44)) fileLine(0) = newline1 fileLine(1) = newline2 newFile = Join(fileLine, vbCrLf) done = writeFile(actFile, newFile) End If End If Next End Function Function resetDay() mbrFile = readFile(pathData & "members.dat") acctName = Split(mbrFile, vbCrLf) For i = 0 to UBound(acctName) actFile = pathData & acctName(i) & ".act" thisAcctAct = readFile(actFile) fileLine = Split(thisAcctAct, vbCrLf) ReDim Preserve fileLine(20) If fileLine(0) <> "" then line1 = Split(fileLine(0), chr(44)) If line1(listNumber) <> "-1" then line1(listNumber) = "0" line1(nLists + listNumber + 1) = "0" newline1 = Join(line1, chr(44)) fileLine(0) = newline1 newFile = Join(fileLine, vbCrLf) done = writeFile(actFile, newFile) End If End If Next End Function Function create() ' Following code for RANK BY TODAYS HITS control = 1 mbrFile = readFile(pathData & "members.dat") acctName = Split(mbrFile, vbCrLf) For i = 0 to UBound(acctName) thisAcctDat = readFile(pathData & acctName(i) & ".dat") thisAcctAct = readFile(pathData & acctName(i) & ".act") If thisAcctAct <> "" then acctArray = Split(thisAcctAct, vbCrLf) If rankBy(listNumber) = "week" then hitLine = Split(acctArray(1), chr(44)) ElseIf rankBy(listNumber) = "total" then hitLine = Split(acctArray(2), chr(44)) Else hitLine = Split(acctArray(0), chr(44)) End If ReDim Preserve hitLine(2 * nLists + 2) If CInt(hitLine(listNumber)) >= minHits(listNumber) then goodAcct(control,0) = hitLine(listNumber) ' account hits in goodAcct(control,1) = hitLine(1 + nLists + listNumber) ' account hits out acctInfo = Split(thisAcctDat, vbCrLf) goodAcct(control,2) = acctInfo(3 * listNumber + 3) ' account image goodAcct(control,3) = acctInfo(3 * listNumber + 4) ' account description goodAcct(control,4) = acctInfo(1) ' site name goodAcct(control,5) = acctName(i) ' account name control = control + 1 End If End If Next rankem() End Function Function rankem() If weekend = 1 then reset = resetWeek() weekend = 0 ElseIf dayend = 1 then reset = resetDay() dayend = 0 End If ReDim goodTemp(control,5) For i = 1 to (control - 1) For ii = (i+1) to (control - 1) If CInt(goodAcct(ii,0)) > CInt(goodAcct(i,0)) then For iii = 0 to 5 goodTemp(i,iii) = goodAcct(i,iii) goodAcct(i,iii) = goodAcct(ii,iii) goodAcct(ii,iii) = goodTemp(i,iii) Next End If Next Next mxPage = Int((nRanked(listNumber) / perPage(listNumber))) If mxPage < 1 then mxPage = 1 End If startRank = 1 endRank = perPage(listNumber) For page = 1 to mxPage html(page) = getHeader(page) If rankStyle(listNumber) = "toplist" then html(page) = html(page) & "
" rankGroup = 0 adControl = 1 For i = startRank to endRank html(page) = html(page) & "" If howRank(listNumber,rankGroup,1) < i then rankGroup = rankGroup + 1 If rankGroup > 2 then rankGroup = 2 End If End If useImg = howRank(listNumber,rankGroup,2) titleSize = howRank(listNumber,rankGroup,3) descSize = howRank(listNumber,rankGroup,4) If showRank(listNumber) = "yes" then html(page) = html(page) & "" End If If goodAcct(i,5) <> "" then If useImg = "yes" then html(page) = html(page) & "" html(page) = html(page) & "" Else html(page) = html(page) & "" End If Else html(page) = html(page) & "" goodAcct(i,0) = " " goodAcct(i,1) = " " End If If showIn(listNumber) = "yes" then html(page) = html(page) & "" End If If showOut(listNumber) = "yes" then html(page) = html(page) & "" End If html(page) = html(page) & "" ' Check for AD BREAK HERE If adBreak(listNumber,adControl) = i then break = getAdBreak(page,adControl) If break <> "" then html(page) = html(page) & "
RankSiteInOut
" & CStr(i) & "" & goodAcct(i,4) & "
" html(page) = html(page) & "" & goodAcct(i,3) & "		" & goodAcct(i,4) & "
" html(page) = html(page) & "" & goodAcct(i,3) & "		Your Site Here" & goodAcct(i,0) & "" & goodAcct(i,1) & "
" & break html(page) = html(page) & "
" html(page) = html(page) & "" adControl = adControl + 1 End If If adControl > 3 then adControl = 0 End If End If Next html(page) = html(page) & "
RankSiteInOut
" ElseIf rankStyle(listNumber) = "friends" then html(page) = html(page) & "
" rankGroup = 0 adControl = 1 friendBreak = 0 For i = startRank to endRank html(page) = html(page) & "" End If If goodAcct(i,5) <> "" then html(page) = html(page) & "" & goodAcct(i,4) & "" If useImg = "yes" then html(page) = html(page) & "
" End If Else html(page) = html(page) & "Your Site Here" goodAcct(i,0) = " " goodAcct(i,1) = " " End If If showIn(listNumber) = "yes" then html(page) = html(page) & "
In " & goodAcct(i,0) & " " End If If showOut(listNumber) = "yes" then html(page) = html(page) & " Out " & goodAcct(i,1) & "" End If html(page) = html(page) & "" friendBreak = friendBreak + 1 If friendBreak = friendsRow(listNumber) then friendBreak = 0 html(page) = html(page) & "" If adBreak(listNumber,adControl) = i then break = getAdBreak(page,adControl) If break <> "" then html(page) = html(page) & "
" If howRank(listNumber,rankGroup,1) < i then rankGroup = rankGroup + 1 If rankGroup > 2 then rankGroup = 2 End If End If useImg = howRank(listNumber,rankGroup,2) titleSize = howRank(listNumber,rankGroup,3) If showRank(listNumber) = "yes" then html(page) = html(page) & "" & CStr(i) & "
" & break html(page) = html(page) & "
" adControl = adControl + 1 End If If adControl > 3 then adControl = 0 End If End If End If ' Check for AD BREAK HERE Next html(page) = html(page) & "
" End If startRank = (page * perPage(listNumber)) + 1 endRank = (page * perPage(listNumber)) + perPage(listNumber) If endRank > nRanked(listNumber) then endRank = nRanked(listNumber) End If dx = getFooter(page) html(page) = html(page) & dx If page > 1 then fileArray = Split(topFile(listNumber), ".") fileArray(0) = fileArray(0) & CStr(page) file2Create = Join(fileArray, ".") done = writeFile(pathToFile(listNumber) & file2Create, html(page)) Else done = writeFile(pathToFile(listNumber) & topFile(listNumber), html(page)) End If Next gohome() End Function Function getHeader(pageNum) getHeader = readFile(pathData & "header" & CStr(listNumber) & CStr(pageNum) & ".txt") End Function Function getFooter(pageNum) getFooter = readFile(pathData & "footer" & CStr(listNumber) & Cstr(pageNum) & ".txt") End Function Function getAdBreak(pageNum,adNum) getAdBreak = readFile(pathData & "adbreak" & CStr(listNumber) & CStr(pageNum) & CStr(adNum) & ".txt") End Function %>