<% 'Since a lot of functions derive from populating records off bat: 'This is mandatory! Dim i: i = 0 Dim CatName Dim CatCount: CatCount = 0 Dim same: same = "" Dim HereLast: HereLast = True Dim IntValSR: IntValSR = 20 Dim val: val = Request.Form("SearchQuery") Dim tb: tb = 0 Dim bfr: bfr = "" Dim spaces: spaces = 0 Dim multkey Dim cond: cond = 0 Dim cond2: cond2 = false Dim xs: xs = 0 Dim MarkDup: MarkDup = false Dim SuppressOr: SuppressOr = False Dim LRC: LRC = 0 Dim DIVRC: DIVRC = 0 Dim SR: SR = "20" Dim cxd: cxd = 0 Dim pfont: pfont = "

" & vbCrLf Dim hyperlinkstart: hyperlinkstart = "" Dim j: j = 0 Dim k: k = 0 Dim rowtest: rowtest = 0 Dim x if request.querystring("x") = "" Then 'Keep != 'AndersonNancy' on everything 'Current Table Order: '0 - Category '1 - Name (Name of Treatment) '2 - Data set x = new TreatmentQuery 'For Identifiers below, we will use the dynamic array CatName Dim QueryToUse: QueryToUse = "SELECT Category, Name FROM Treatments WHERE Category != 'AndersonNancy' ORDER BY Category ASC" x.PopulateRecords QueryToUse 'This will assign the actual category names to CatName array. For i = 0 to x.Rowcount - 1 If x.RS_data(0, i) <> same then same = x.RS_data(0, i) If same <> "" Then CatCount = CatCount + 1 If CatCount > 1 then ReDim Preserve CatName(CatCount) CatName(CatCount - 1) = same Else ReDim CatName(1) CatName(CatCount - 1) = same End If End If End If Next set x = nothing If val <> "" Then 'This is a nice little keyword parser for a search engine I made. 'Pretty simple to fix that though. 'Variables are a bit obscure, so sorry about that If someone Else 'takes over. Was getting to be a serious headache. reDim multkey(1) multkey(0) = "" val = trim(val) If len(val) > 0 Then For I = 1 to len(val) tb = asc(ucase(mid(val, i, 1))) If (tb > 47) AND (tb < 58) THEN bfr = bfr & chr(tb) ElseIf (tb > 64) AND (tb < 91) THEN bfr = bfr & chr(tb) ElseIf (tb = 32) Then spaces = spaces + 1 bfr = bfr & chr(tb) End If Next val = bfr bfr = "" If spaces > 0 THEN 'Basically If the program even detected a space, it will fall through here to check If parsing 'Is needed. spaces = 0 For I = 1 to len(val) tb = asc(ucase(mid(val, i, 1))) If (tb = 32) AND (NOT Cond2) Then Cond = I 'Obviously this sets Cond Cond2 = True 'Default is false 'SECOND TIME AROUND AND MORE: Supposed to see If values before are duplicates, and If not assign them. bfr = Trim(bfr) 'Remove spaces from the buffer If I > 1 AND Trim(bfr) <> "" Then 'Second Time Around: spaces = spaces + 1 'Increase Spaces. (Like from the rip it makes 0 to 1) For XS = 1 To Spaces 'XS 1 to Spaces. So If it's to it is 1 - 2. That correlates with multikey. If NOT(UBOUND(MultKey) < (XS - 2)) THEN If Bfr <> "AND" and MultKey(XS - 1) = Bfr Then 'This means AND is not there, and this is same thing as some other value. MarkDup = True End If End If Next If NOT MarkDup Then 'Ok Do this If it's not a duplicate. MarkDup starts as false. ReDim Preserve multkey(spaces) 'Resize Keyword Array to sizes. Gotta be 2. multkey(spaces - 1) = bfr Else spaces = spaces - 1 End If MarkDup = False Else multkey(0) = bfr 'If it's less than 2 spaces, apparently it's 0. Corresponding to spaces with array. Thus setting 0, is setting 1. So it's right. End If bfr = "" 'Clear BFR ElseIf (tb = 32) AND (Cond < I) Then 'SPACE FOUND BEFORE THIS SPACE, JUST KEEP THROWING COND SO ABOVE CODE DOESN'T LOAD Cond = Cond + 1 'Cond should mean that a space was already pressed since when it's done it sets it at whatever I is Else 'STANDARD CHARACTER FOUND (RESET COND, AND COND 2): 'THEN ADD TO BUFFER TO THROW INTO AN ARRAY: Cond2 = False Cond = 0 bfr = bfr & chr(tb) End If Next If Spaces >= 1 Then 'THIS IS FOR THE LAST ENTRY (CHECKING If DUPLICATES ARE FOUND): bfr = Trim(bfr) 'Remove spaces from the buffer MarkDup = False spaces = spaces + 1 'Increase Spaces. (Like from the rip it makes 0 to 1) For XS = 1 To Spaces 'XS 1 to Spaces. So If it's to it is 1 - 2. That correlates with multikey. If NOT(UBOUND(MultKey) < (XS - 2)) THEN If Bfr <> "AND" and MultKey(XS - 1) = Bfr Then 'This means AND is not there, and this is same thing as some other value. MarkDup = True End If End If Next If NOT MarkDup Then 'Ok Do this If it's not a duplicate. MarkDup starts as false. ReDim Preserve multkey(spaces) 'Resize Keyword Array to sizes. Gotta be 2. multkey(spaces - 1) = bfr Else spaces = spaces - 1 End If End If Else 'THIS OCCURS WITH ONLY ONE KEYWORD: multkey(0) = trim(val) spaces = 1 End If If multkey(0) <> "" Then 'If RESULTS ARE FOUND, GENERATE SQL CODE BASED UPON KEYWORDS QueryToUse = "SELECT * FROM Treatments " & _ " WHERE (Category != 'AndersonNancy') AND " If UBOUND(MultKey) > 1 Then QueryToUse = QueryToUse & "(" For I = 1 to UBOUND(MultKey) QueryBuffer = "" If I > 1 THEN If NOT multkey(i - 1) = "AND" THEN If NOT SuppressOr Then QueryBuffer = QueryBuffer & " OR " Else SuppressOr = False End If Else If NOT (I = UBOUND(MultKey)) THEN If (NOT multkey(i - 2) = "AND") THEN If NOT multkey(i) = "AND" THEN QueryBuffer = QueryBuffer & " AND " SuppressOr = True End If End If End If End If End If If NOT MultKey(i - 1) = "AND" THEN QueryBuffer = QueryBuffer & "(Name LIKE '%" & multkey(i - 1) & "%' " & _ "OR Category LIKE '%" & multkey(i - 1) & "%' " & _ "OR Data LIKE '%" & multkey(i - 1) & "%') " End If QueryToUse = QueryToUse & QueryBuffer Next If UBOUND(MultKey) > 1 Then QueryToUse = QueryToUse & ")" QueryToUse = QueryToUse & " ORDER BY Name ASC" End If End If End If End If %> First Church of Religious Science NYC - Treatment Department <% StyleSheetNumber = 1 ReadHeader StyleSheet %> <% ReadHeader TopHeader ReadHeader BannerWrapper %> <% response.write "


" if request.querystring("x") = "" Then response.write "

Find Treatments:" Else '//////////////////////// PUT CODE BELOW TO DISPLAY TREATMENT //////////////////////// 'If there are issues remove everything after and including WHERE Data Like if request.querystring("TN") <> "" Then DIM TN DIM T_BFR TN = request.querystring("TN") TN = Replace(TN, "_", " ") TN = Trim(TN) QueryToUse = "SELECT * FROM Treatments" set x = new TreatmentQuery x.PopulateRecords QueryToUse dim IJK for IJK = 0 to x.RowCount - 1 if x.RS_Data(1, IJK) = TN Then Response.Write "

" & x.RS_Data(1, IJK) & "

" & chr(10) & chr(13) & "
" & chr(10) & chr(13) response.write "
" T_BFR = x.RS_DATA(2, IJK) End if next If len(T_BFR) > 2 Then If left(T_BFR, 2) = Chr(13) & chr(10) Then T_BFR = Right(T_BFR, len(T_BFR) - 2) End if End If T_BFR = Trim(T_BFR) T_BFR = Replace(T_BFR, "I Love", "Dare") T_BFR = REPLACE(T_BFR , chr(13) & chr(10) & chr(13) & chr(10) & chr(13) & chr(10) & chr(13) & chr(10), chr(13) & chr(10) & chr(13) & chr(10)) & "" T_BFR = "
" & REPLACE(T_BFR , chr(13) & chr(10) & chr(13) & chr(10), "

" & chr(13) & chr(10)) & "
" T_BFR = REPLACE(T_BFR, "And so it is.", "And so it is.
") set x = Nothing response.write T_BFR response.write "

BACK

" & chr(13) & chr(10) End if ' '//////////////////////// END //////////////////////// End if %> <% if request.querystring("x") = "" Then If SR = "" Then SR = "20" End if Response.Write "" Response.Write "Results Per Page:

" End if %> <% if request.querystring("x") = "" Then DIM XTRA: XTRA = 0 cxd = 0 j = 0 DIM XEA: XEA = 0 If NOT (VAL = "") Then If x.RowCount > 0 Then Response.Write "

Results: " & x.RowCount & "

" & vbCrLf Response.Write "
" & vbCrLf Response.Write "
" & vbCrLf cxd = cxd + 1 Response.Write "" & vbCrLf Do While j < x.rowcount If rowtest = 0 then Response.Write "" & vbCrLf RowTest = RowTest + 1 XTRA = XTRA + 1 j = j + 1 k = j 'Pass one If (k) Mod 2 = 1 then Response.Write "" & chr(13) & chr(10) IF XTRA mod IntValSR = 0 Then Response.Write "" & vbCrLf RowTest = 0 Response.Write "
" & vbCrLf Else Response.Write "" & vbCrLf End If response.write "" & x.RS_DATA(1, k - 1) & "
" & vbCrLf '///////////////////////////////////////// 'SET #1 if (cxd + 1) * IntValSr > x.rowcount then xea = x.rowcount else xea = (cxd + 1) * IntValSR end if if xea <= x.rowcount then Response.Write "Results: " & (k + 1) & " - " & xea & "" & vbCrLf end if '///////////////////////////////////////// Response.Write "
" & vbCrLf IF (k + 1) < x.RowCount Then Response.Write "
" & vbCrLf Response.Write "" & vbCrLf cxd = cxd + 1 End if XTRA = 0 End if 'Pass two If (k + 1) < x.ROWCOUNT - 1 Then j = j + 1 XTRA = XTRA + 1 If rowtest = 0 then Response.Write "" & vbCrLf RowTest = RowTest + 1 If (k + 1) Mod 2 = 1 then Response.Write "" & chr(13) & chr(10) IF XTRA mod IntValSR = 0 Then Response.Write "" & vbCrLf RowTest = 0 Response.Write "
" & vbCrLf Else Response.Write "" & vbCrLf End If response.write "" & x.RS_DATA(1, k) & "
" & vbCrLf '//////////////////////////////////////// 'SET #2 if (cxd + 1) * IntValSr > x.rowcount then xea = x.rowcount else xea = (cxd + 1) * IntValSR end if if xea <= x.rowcount then Response.Write "Results: " & (k + 2) & " - " & xea & "" & vbCrLf end if '///////////////////////////////////////// Response.Write "
" & vbCrLf IF (K + 2) < x.RowCount Then Response.Write "
" & vbCrLf Response.Write "" & vbCrLf cxd = cxd + 1 End if XTRA = 0 End if End If 'Pass 3 If (k + 2) < x.ROWCOUNT - 1 Then j = j + 1 XTRA = XTRA + 1 If rowtest = 0 then Response.Write "" & vbCrLf RowTest = RowTest + 1 If (k + 2) Mod 2 = 1 then Response.Write "" & chr(13) & chr(10) IF XTRA mod IntValSR = 0 Then Response.Write "" & vbCrLf RowTest = 0 Response.Write "
" & vbCrLf Else Response.Write "" & vbCrLf End If response.write "" & x.RS_DATA(1, k + 1) & "
" & vbCrLf '///////////////////////////////////////// 'SET #3 if (cxd + 1) * IntValSr > x.rowcount then xea = x.rowcount else xea = (cxd + 1) * IntValSR end if if xea <= x.rowcount then Response.Write "Results: " & (k + 3) & " - " & xea & "" & vbCrLf end if '///////////////////////////////////////// Response.Write "
" & vbCrLf IF (K + 3) < x.RowCount Then Response.Write "
" & vbCrLf Response.Write "" & vbCrLf cxd = cxd + 1 End if XTRA = 0 End if End If If RowTest >= 3 Then response.Write "" & vbCrLf RowTest = 0 End If Loop If RowTest <> 0 THEN Response.Write "" & vbCrLf Response.Write "
" & vbCrLf Response.Write "
" & vbCrLf ELSE Response.Write "" & vbCrLf Response.Write "
" & vbCrLf End If ELSE response.write "
" End If set x = nothing j = 0 k = 0 response.write "
" rowtest = 0 End If ELSE response.write "
" response.write "
" End If %>

<% %>
<% if request.querystring("x") = "" Then response.write "

CATEGORIES:

" End if %> <% if request.querystring("x") = "" Then If CatCount > 0 THEN Response.Write "" Do while j < (CatCount) 'Write the categories in a table sorted in 5 columns. 'Rows will adapt. If rowtest = 0 then Response.Write "" j = j + 1 k = j Response.Write "" rowtest = rowtest + 1 If (k + 1) < (CatCount - 1) then Response.Write "" j = j + 1 rowtest = rowtest + 1 End If If (k + 2) < (CatCount - 1) then Response.Write "" j = j + 1 rowtest = rowtest + 1 End If If (k + 3) < (CatCount - 1) then Response.Write "" j = j + 1 rowtest = rowtest + 1 End If If (k + 4) < (CatCount - 1) then Response.Write "" j = j + 1 rowtest = rowtest + 1 End If If RowTest = 5 then RowTest = 0 Response.Write "" End If Loop If RowTest > 0 THEN Response.Write "" Response.Write "
" & pfont & hyperlinkstart & (k) & hyperlinkend & CatName(k - 1) & "

" & pfont & hyperlinkstart & (k + 1) & hyperlinkend & CatName(k) & "

" & pfont & hyperlinkstart & (k + 2) & hyperlinkend & CatName(k + 1) & "

" & pfont & hyperlinkstart & (k + 3) & hyperlinkend & CatName(k + 2) & "

" & pfont & hyperlinkstart & (k + 4) & hyperlinkend & CatName(k + 3) & "

" Else Response.Write "There's no treatments in the database." End If End if %>
<% readheader SideBar %>




<% readheader BottomBar readheader Copyright if request.querystring("x") = "" Then WriteNestedPopups CatName, CatCount %>