<% Dim frmAction, i Dim joinList(), subImg(), subDesc(), subUrl() frmAction = Request("action") Select Case frmAction Case "newacct" %> <%= listName(0) %> - Add / Edit Your Account
Thank you for joining <%= listName(0) %>!
 
: Account Name (up to 10 letters/numbers)

: Password

: Site Title (12 letters/numbers Only!)

: Email Address

Full URL to your website index or main page

Full URL to image (dimensions: <%= imgSize(0) %>)

<% If multiSite = 1 then Response.Write "Sub-lists
Hits in to these lists count towards your ranking on " & listName(0) & " as well!

" For i = 1 to nLists Response.Write " : Check Here to particpate in " & listName(i) & "
 
" Response.Write "Full URL to Free Picture Page (Your hits out will be sent here)
" Response.Write "
 
" Response.Write "Full URL to thumbnail image to use by your link (size: " & imgSize(i) & ")
" Response.Write "
 
" Response.Write "

" Next End If %>

<% Case "banners" howLink = fileRead(pathData & "linking.txt") Response.Write howLink Response.Write "
 
" Response.End Case "edit" %> <%= listName(0) %> - Add / Edit Your Account
: Account Name to Edit

: Password

<% Case "loginstats" %> <%= listName(0) %> - Check Stats
: Account Name

: Password

<% Case "editacct" acct2Edit = Request("username") editPass = Request("password") If acct2Edit = "" or editPass = "" then Response.Write "

Empty Form Field

" Response.End End If mbrFile = fileRead(pathData & "members.dat") mbrList = Split(mbrFile, vbCrLf) If InStr(mbrFile, acct2Edit & vbCrLf) then For i = 0 to UBound(mbrList) If acct2Edit = mbrList(i) then Exit For End If Next Else Response.Write "

Account Not Found

" Response.End End If thisMbrFile = fileRead(pathData & mbrList(i) & ".dat") thisMbrDat = Split(thisMbrFile, vbCrLf) adminPass = fileRead(pathData & "password.cgi") If editPass <> thisMbrDat(0) AND editPass <> adminPass then Response.Write "

Invalid Password

" Response.End End If %> <%= listName(0) %> - Edit Your Account
> : Site Title (do not use all CAPS)

: Full URL to your website

: Full URL to image (dimensions: <%= imgSize(0) %>)

: Description

<% If multiSite = 1 then Response.Write "Sub-lists
Hits in to these lists count on main list as well!

" For i = 1 to nLists If thisMbrDat(3 * i + 4) <> "" then checkBox = "checked" Else checkBox = "" End If Response.Write " : Check Here to particpate in " & listName(i) & "
 
" Response.Write "Full URL to Free Picture Page (Your hits out will be sent here)
" Response.Write "
 
" Response.Write "Full URL to thumbnail image to use by your link (size: " & imgSize(i) & ")
" Response.Write "
 
" Response.Write "

" Next End If %>

<% Case "stats" acct2Edit = Request("username") editPass = Request("password") If acct2Edit = "" or editPass = "" then Response.Write "

Empty Form Field

" Response.End End If mbrFile = fileRead(pathData & "members.dat") mbrList = Split(mbrFile, vbCrLf) If InStr(mbrFile, acct2Edit & vbCrLf) then For i = 0 to UBound(mbrList) If acct2Edit = mbrList(i) then Exit For End If Next Else Response.Write "

Account Not Found

" Response.End End If thisMbrFile = fileRead(pathData & mbrList(i) & ".dat") thisMbrDat = Split(thisMbrFile, vbCrLf) adminPass = fileRead(pathData & "password.cgi") If editPass <> thisMbrDat(0) AND editPass <> adminPass then Response.Write "

Invalid Password

" Response.End End If thisMbrActFile = fileRead(pathData & mbrList(i) & ".act") thisMbrAct = Split(thisMbrActFile, vbCrLf) thisMbrToday = Split(thisMbrAct(0), ",") thisMbrWeek = Split(thisMbrAct(1), ",") thisMbrTotal = Split(thisMbrAct(2), ",") %>
<%= listName(0) %> : <%= acct2Edit %>
In today: <%= thisMbrToday(0) %>
Out today: <%= thisMbrToday(1) %>
In week: <%= thisMbrWeek(0) %>
Out week: <%= thisMbrWeek(1) %>
In total: <%= thisMbrTotal(0) %>
Out total: <%= thisMbrTotal(1) %>
<% Case "update" ReDim joinList(nLists), subImg(nLists), subDesc(nLists), subUrl(nLists) newUser = Request("username") newPass = Request("password") newUrl = Request("url") If LCase(Left(newUrl, 7)) <> "http://" then Response.Write "Invalid website URL" Response.End End If newImg0 = Request("img0") strTest = LCase(Left(newImg0, 7)) If strTest <> "http://" AND strTest <> "" then Response.Write "Invalid URL to site image" Response.End End If newDescribe0 = Request("describe0") newDescribe0 = Replace(newDescribe0, vbCrLf, " ") If Len(newDescribe0) > 200 then newDescribe0 = Left(newDescribe0,200) End IF siteTitle = Request("title") emailAdd = Request("email") If multiSite = 1 then For i = 1 to nLists subList = "list" & CStr(i) joinList(i) = Request(subList) If joinList(i) = "true" then strVar = "img" & CStr(i) subImg(i) = Request(strVar) strVar = "outUrl" & Cstr(i) subUrl(i) = Request(strVar) strVar = "describe" & CStr(i) subDesc(i) = Request(strVar) subDesc(i) = Replace(subDesc(i), vbCrLf, " ") If Len(subDesc(i)) > 200 then subDesc(i) = Left(subDesc(i),200) End If End If Next End If userFile = pathData & newUser & ".dat" userRecord = newPass & vbCrLf & siteTitle & vbCrLf & emailAdd & vbCrLf & newImg0 & vbCrLf & newDescribe0 & vbCrLf & newUrl & vbCrLf If multiSite = 1 then For i = 1 to nLists userRecord = userRecord & subImg(i) & vbCrLf & subDesc(i) & vbCrLf & subUrl(i) & vbCrLf Next End if f = writeFile(userFile, userRecord) actFile = fileRead(pathData & newUser & ".act") actLine = Split(actFile, vbCrLf) line1 = Split(actLine(0), chr(44)) line2 = Split(actLine(1), chr(44)) line3 = Split(actLine(2), chr(44)) For i = 1 to nLists If joinList(i) = "true" And line1(i) = "-1" then line1(i) = "0" line2(i) = "0" line3(i) = "0" ElseIf joinList(i) <> "true" And line1(i) <> "-1" then line1(i) = "-1" line2(i) = "-1" line3(i) = "-1" End If Next newline1 = Join(line1, chr(44)) newline2 = Join(line2, chr(44)) newline3 = Join(line3, chr(44)) userActivity = newline1 & vbCrLf & newline2 & vbCrLf & newline3 & vbCrLf activityFile = pathData & newUser & ".act" ff = writeFile(activityFile, userActivity) Response.Write "

Account Updated


 
Your link code is: " & cgiUrl & "inclick.php?acct=" & newUser & "
 
" If multiSite = 1 then Response.Write "
To send hits to a specific sublist - you must use the codes listed below. All hits sent under" Response.Write " the following codes COUNT towards the code listed above as well.
 
" For i = 1 to nLists subList = "list" & CStr(i) joinList(i) = Request(subList) If joinList(i) = "true" then Response.Write "For SubList: " & listName(i) & " - Your link code is: " & cgiUrl & "inclick" & CStr(i) & ".php?acct=" & newUser Response.Write "
 
" End If Next End If howLink = fileRead(pathData & "linking.txt") Response.Write howLink Response.Write "

 
" Response.End Case "create" ReDim joinList(nLists), subImg(nLists), subDesc(nLists), subUrl(nLists) newUser = Request("username") If newUser = "" then Response.Write "Missing Username" Response.End End If newUser = LCase(newUser) mbrFile = pathData & "members.dat" strMembers = fileRead(mbrFile) d = Split(strMembers, vbCrLf) For i = 0 to UBound(d) If newUser = d(i) then Response.Write "Username Taken" Response.End End If Next For i = 1 to Len(newUser) intTest = Asc(Mid(newUser, i , 1)) If intTest > 122 OR intTest < 48 then Response.Write "Invalid character in username (letters and numbers only)" Response.End ElseIf intTest > 57 AND intTest < 97 then Response.Write "Invalid character in username (letters and numbers only)" Response.End End If Next newPass = Request("password") If Len(newPass) < 4 then Response.Write "Password missing or too short (minimum 4 characters)" Response.End End If newUrl = Request("url") If LCase(Left(newUrl, 7)) <> "http://" then Response.Write "Invalid website URL" Response.End End If If checkBlock(Request("url")) = 1 Then Response.Write "Website banned from list." Response.End End If Function checkBlock(thisUrl) On Error Resume Next blockFile = pathData & "block.dat" strBlock = fileRead(blockFile) blockArray = Split(strBlock, vbCrLf) For i = 0 To Ubound(blockArray) If Instr(LCase(thisUrl), blockArray(i)) Then checkBlock = 1 End If Next End Function newImg0 = Request("img0") strTest = LCase(Left(newImg0, 7)) If strTest <> "http://" AND strTest <> "" then Response.Write "Invalid URL to site image" Response.End End If newDescribe0 = Request("describe0") newDescribe0 = Replace(newDescribe0, vbCrLf, " ") If Len(newDescribe0) > 200 then newDescribe0 = Left(newDescribe0,200) End If siteTitle = Request("title") emailAdd = Request("email") If multiSite = 1 then For i = 1 to nLists subList = "list" & CStr(i) joinList(i) = Request(subList) If joinList(i) = "true" then strVar = "img" & CStr(i) subImg(i) = Request(strVar) strVar = "outUrl" & CStr(i) subUrl(i) = Request(strVar) strVar = "describe" & CStr(i) subDesc(i) = Request(strVar) subDesc(i) = Replace(subDesc(i), vbCrLf, " ") If Len(subDesc(i)) > 200 then subDesc(i) = Left(subDesc(i),200) End If End If Next End If userFile = pathData & newUser & ".dat" userRecord = newPass & vbCrLf & siteTitle & vbCrLf & emailAdd & vbCrLf & newImg0 & vbCrLf & newDescribe0 & vbCrLf & newUrl & vbCrLf If multiSite = 1 then For i = 1 to nLists userRecord = userRecord & subImg(i) & vbCrLf & subDesc(i) & vbCrLf & subUrl(i) & vbCrLf Next End If f = createFile(userFile, userRecord) userActivity = "0" If multiSite = 1 then For i = 1 to nLists If joinList(i) = "true" then userActivity = userActivity & ",0" Else userActivity = userActivity & ",-1" End If Next End If For i = 0 to nLists userActivity = userActivity & ",0" Next userActivity = userActivity & vbCrLf & userActivity & vbCrLf & userActivity & vbCrLf activityFile = pathData & newUser & ".act" ff = createFile(activityFile, userActivity) strMembers = strMembers & newUser & vbCrLf Set fsobj = Server.CreateObject("Scripting.FileSystemObject") Set tsobj = fsobj.OpenTextFile(mbrFile, 2) tsobj.Write strMembers tsobj.Close done = SendMail(emailAdd, mailFrom, mailSub) Response.Write "

Account Added


 
Your link code is: " & cgiUrl & "inclick.php?acct=" & newUser & "
 
" If multiSite = 1 then Response.Write "
To send hits to a specific sublist - you must use the codes listed below. All hits sent under" Response.Write " the following codes COUNT towards the code listed above as well.
 
" For i = 1 to nLists subList = "list" & CStr(i) joinList(i) = Request(subList) If joinList(i) = "true" then Response.Write "For SubList: " & listName(i) & " - Your link code is: " & cgiUrl & "inclick" & CStr(i) & ".php?acct=" & newUser Response.Write "
 
" End If Next End If howLink = fileRead(pathData & "linking.txt") Response.Write howLink Response.Write "

 
" Response.End Case Else %> <%= listName(0) %> - Add / Edit Your Account

In order to maintain quality in our Traffic Exchange program,
we must ask that the following guidelines be adhered to :

1) You must be a pay site
2) No AVS sites
3) No linklist
4) Site image may not contain hardcore or be animated
5) No blind or misleading links
6) NO entrance pop ups
7) We review sites for content and reserve the right to remove sites for any reason and without notice

Create a new account

Modify an existing account

Approved banners and text links

Check stats

<% End Select Function fileRead(filename) Dim fso, ts, at Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(filename, 1) at = ts.ReadAll fileRead = at ts.Close End Function Function writeFile(filename, filedata) Dim fso, ts Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.OpenTextFile(filename, 2) ts.Write filedata ts.Close End Function Function createFile(filename, filedata) Dim fso, ts Set fso = Server.CreateObject("Scripting.FileSystemObject") Set ts = fso.CreateTextFile(filename, False) ts.Write filedata ts.Close End Function Function SendMail(mTo, mFrom, mSubj) On Error Resume Next Dim objEmail, strBody Set objEmail = Server.CreateObject("CDONTS.NewMail") objEmail.To = mTo objEmail.From = mFrom objEmail.Subject = mSubj strBody = "Thank you for joining " & listName(0) & vbCrLf & vbCrLf strBody = strBody & "Your account information is: " & vbCrLf strBody = strBody & "Account Name: " & Request("username") & vbCrLf strBody = strBody & "Password: " & Request("password") & vbCrLf strBody = strBody & "Link Code: " & cgiUrl & "inclick.php?acct=" & Request("username") & vbCrLf If multiSite = 1 then strBody = strBody & "To send hits to a specific sublist - you must use the link codes below. All hits sent under the following codes COUNT towards the code listed above as well." For i = 1 to nLists subList = "list" & CStr(i) joinList(i) = Request(subList) If joinList(i) = "true" then strBody = strBody & "For SubList: " & listName(i) & " - Your link code is: " & cgiUrl & "inclick" & CStr(i) & ".php?acct=" & Request("username") & vbCrLf End If Next End If strBody = strBody & vbCrLf & "You can edit your account at: " & cgiUrl & "editmember.php" & vbCrLf strBody = strBody & "You can view the list at: " & listUrl(0) & vbCrLf & vbCrLf strBody = strBody & "Remember - The more hits you send, the more hits you receive!" & vbCrLf objEmail.Body = strBody objEmail.Send Set objEmail = nothing End Function %>