<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%> - Coolbubble - <% ' URL Utility functions. ' Test Function sub testUrlFunctions RESPONSE.WRITE("
testUrlFunctions:") RESPONSE.WRITE("
curPageURL = " & curPageURL()) RESPONSE.WRITE("
curPageURLWithVariables = " & curPageURLWithVariables()) RESPONSE.WRITE("
curPageName = " & curPageName()) RESPONSE.WRITE("
curPageNameWithVariables = " & curPageNameWithVariables()) end sub ' Example: "http://www.coolbubble.com/test.asp" function curPageURL() dim s, protocol, port if Request.ServerVariables("HTTPS") = "on" then s = "s" else s = "" end if protocol = strleft(LCase(Request.ServerVariables("SERVER_PROTOCOL")), "/") & s if Request.ServerVariables("SERVER_PORT") = "80" then port = "" else port = ":" & Request.ServerVariables("SERVER_PORT") end if curPageURL = protocol & "://" & Request.ServerVariables("SERVER_NAME") &_ port & Request.ServerVariables("SCRIPT_NAME") end function ' Example: "http://www.coolbubble.com/test.asp?nick=10" function curPageURLWithVariables() dim url url = curPageURL() if Request.ServerVariables("QUERY_STRING") <> "" then url = url & "?" & Request.ServerVariables("QUERY_STRING") end if curPageURLWithVariables = url end function ' Example: "test.asp" function curPageName() dim pagename pagename = Request.ServerVariables("SCRIPT_NAME") if inStr(pagename, "/") > 0 then pagename = Right(pagename, Len(pagename) - instrRev(pagename, "/")) end if curPageName = pagename end function ' Example: "test.asp?nick=10" function curPageNameWithVariables() dim url url = curPageName() if Request.ServerVariables("QUERY_STRING") <> "" then url = url & "?" & Request.ServerVariables("QUERY_STRING") end if curPageNameWithVariables = url end function function strLeft(str1,str2) strLeft = Left(str1,InStr(str1,str2)-1) end function %> <% ' *** FUNCTIONS *** dim databasePassword databasePassword = "dbconnectpw1384" dim conn ' Some Site wide config variables. ' dim g_showComments const g_enableComments = true const g_sendMailNotificationOnNewComment = true const g_enableUrlInComments = true ' All connections to the database should be made through this function. function databaseConnect(s) set conn=s.CREATEOBJECT("ADODB.Connection") conn.Provider="Microsoft.Jet.OLEDB.4.0" conn.Open(s.Mappath("..\private\maindb_001.mdb")) 'conn.Open(s.Mappath("iis642\domains\c\coolbubble.com\user\private\maindb_001.mdb")) end function function databaseConnectFrom2Deep(s) set conn=s.CREATEOBJECT("ADODB.Connection") conn.Provider="Microsoft.Jet.OLEDB.4.0" conn.Open(s.Mappath("..\..\..\private\maindb_001.mdb")) 'conn.Open(s.Mappath("iis642\domains\c\coolbubble.com\user\private\maindb_001.mdb")) end function ' Returns a date string in the following format "Sun Nov 1, 21:17" function createDateString( in_date ) month_part = MONTHNAME(MONTH(in_date), True) day_part = WEEKDAYNAME(WEEKDAY(in_date), True) day_number_part = DAY(in_date) time_part = FORMATDATETIME(in_date,vbshorttime) createDateString = day_part & " " & month_part & " " & day_number_part & ", " & time_part end function ' Returns user name when passed the user id. function getNameFromID(user_id) rsname.Open "Select * FROM USERS where user_id = " & user_id , conn getNameFromID = rsname.Fields("user_name").value rsname.close end function ' Query if the currently logged in user can edit a post by the supplied user. function canEditPost(user_id) IF Session("logged_in")<>1 then ' Not logged in so can't edit post. canEditPost = 0 ELSE 'if Session("user_level=2") ' Logged in, is this the users post? IF Session("user_level") = 2 OR Session("user_id") = user_id then canEditPost = 1 end IF end IF end function ' Query if the currently logged in user can create a new post of any type (must be a moderator) function canCreateModPost() IF Session("logged_in")<>1 then ' Not logged in so can't edit post. canCreateModPost = 0 ELSE ' Logged in, is this the users post? IF Session("user_level") = 2 then canCreateModPost = 1 end IF end IF end function ' Sanatise text - make special characters safe for display. function convertSpecialCharacters(input_text) IF input_text <> empty then input_text = REPLACE(input_text, "<", "<") input_text = REPLACE(input_text, ">", ">") 'input_text = REPLACE(input_text, """, """") input_text = REPLACE(input_text, "&", "&") input_text = REPLACE(input_text, vbCrLf, "
") 'input_text = Replace(input_text, "java", "") 'input_text = Replace(input_text, "table", "") 'input_text = Replace(input_text, "form", "") 'input_text = Replace(input_text, "alert", "") 'input_text = Replace(input_text, "onclick", "") 'input_text = Replace(input_text, "style", "") 'input_text = Replace(input_text, "html", "") 'input_text = Replace(input_text, "body", "") end IF convertSpecialCharacters = input_text end function ' Convert dangerous characters to codes. function validateInput(input_text) input_text = REPLACE(input_text, "'", "'") ' Apostrophe input_text = REPLACE(input_text, vbCrLf, "
") validateInput = input_text end function ' Strip out angled brackets - used in post headers. ' also limits input to 255 chars function stripAngledBrackets(input_text) input_text = REPLACE(input_text, "<", "") input_text = REPLACE(input_text, ">", "") IF LEN(input_text) > 255 then input_text = LEFT(input_text,255) end IF stripAngledBrackets = input_text end function sub drawHeader %> <% call insertGoogleAnalyticsCode end sub ' Called only from drawHeader sub insertGoogleAnalyticsCode %> <% end sub ' Checks for hit count on an entity. ' If update_log is 1, the hit count is increased by calling this function. function getEntityHitCount(entity_name, update_log) 'set rs = Server.CreateObject("ADODB.recordset") rs.Open "Select * FROM ENTITY_LOG WHERE entity_name = '" & entity_name & "'", conn hits = 0 IF not rs.EOF then hits = rs.Fields("hit_count").value rs.close ELSE hits = 0 rs.close ' Get new row id dim next_entity_id rs.Open "Select max(entity_id) FROM ENTITY_LOG", conn 'RESPONSE.WRITE("next_entity_id: " & rs.Fields(0).value & "
") next_entity_id = rs.Fields(0).value + 1 rs.close ' Need to create an entity row. sql = "INSERT INTO ENTITY_LOG " sql = sql & "VALUES (" & next_entity_id & ", '" & entity_name & "', 0, '" & DATE() & "', '0')" 'RESPONSE.WRITE("SQL: " & sql & "
") on error resume next conn.Execute sql IF err<>0 then 'RESPONSE.WRITE("
ERROR" & err.description) 'RESPONSE.WRITE("Error - couldn't create entity log.") ELSE 'RESPONSE.WRITE("Created new entity log.") end IF end IF ' Increase counter. IF update_log = 1 then sql = "UPDATE ENTITY_LOG SET hit_count = " & hits+1 & " where entity_name = '" & entity_name & "'" on error resume next conn.Execute sql IF err<>0 then 'Response.Write("
ERROR" & err.description) 'response.write("Error - couldn't create entity log.") ELSE 'response.write("Created new entity log.") end IF end IF ' Log referring URLS sPreviousURL = Request.ServerVariables("HTTP_REFERER") if sPreviousURL <> "" then call logReferringURL(sPreviousURL) end if getEntityHitCount = hits end function ' log a referring url. ' REFERRING_URL sub logReferringURL(referring_url) ' First detect any existing rows with the same URL. sql = "select * from REFERRING_URL" sql = sql & " where ru_url = '" & referring_url &"'" rsp.Open sql, conn if rsp.EOF then ' No row was found, insert a new row. rsp.close sql = "INSERT INTO REFERRING_URL (ru_url, ru_date, ru_count) " sql = sql & " values('" & referring_url & "', '" & now() & "', 1)" conn.Execute sql else dim ru_count ru_count = rsp.Fields("ru_count").value rsp.close sql = "UPDATE REFERRING_URL" sql = sql & " set ru_date = '" & now() & "', ru_count = " & ru_count+1 sql = sql & " where ru_url = '" & referring_url & "'" conn.Execute sql end if end sub ' Used for drawing posts on the main page etc. sub drawPost(post_id) dim editUrl dim permLinkUrl dim bodyFixed dim userName dim commentCount dim commentPlural dim sql ' Get count of comments linked to this post. sql = "Select count(*) as _count FROM COMMENTS where post_id = " & post_id sql = sql + " AND deleted = '0'" rsp.Open sql, conn commentCount = 0 commentCount = rsp.Fields("_count").value rsp.close ' Do mail sql select. rsp.Open "Select * FROM POSTS where post_id = " & post_id , conn 'rsname.Open "Select * FROM USERS where user_id = " & rsp.Fields("user_id").value , conn userName = getNameFromID(rsp.Fields("user_id").value) editUrl = "editpost.asp?post_id=" & post_id permLinkUrl = "index.asp?post_id=" & post_id bodyFixed = convertSpecialCharacters(rsp.Fields("body").value) ' Draw permlink icon and create the link. %> <% 'RESPONSE.WRITE(" ") RESPONSE.WRITE(rsp.Fields("heading").value & "" ) RESPONSE.WRITE("

" & bodyFixed & "

") %>
<% RESPONSE.WRITE(" posted by " & userName ) RESPONSE.WRITE(" on " & rsp.Fields("date_created").value) ' Display comment count and create the link. commentPlural = "" if commentCount <> 1 then commentPlural = "s" end if %>  <%RESPONSE.WRITE(commentCount & " comment" & commentPlural & " ") if canEditPost(rsp.Fields("user_id").value) = 1 then %> [edit] <% end if %>

<% rsp.close 'rsname.close end sub ' Draw an individual bookmark from a supplied post id. ' if shorten is 1 then don't draw description. sub drawBookmark(post_id, shorten) rsp.Open "Select * FROM POSTS where post_id = " & post_id , conn dim editUrl dim shortLinkUrl dim linkText editUrl = "editpost.asp?post_id=" & rs.Fields("post_id").value rsname.Open "Select * FROM USERS where user_id = " & rs.Fields("user_id").value , conn ' Shorten the display url if required. linkUrl = rs.Fields("heading").value shortLinkUrl = linkUrl if LEN(shortLinkUrl) > 20 then shortLinkUrl = LEFT(linkUrl,18) + "..." end if %>

<% RESPONSE.WRITE(shortLinkUrl) %><% if shorten <> 1 then RESPONSE.WRITE(" ?" & rs.Fields("body").value) %> ?<% RESPONSE.WRITE(" posted by " & rsname.Fields("user_name").value) RESPONSE.WRITE(" on " & rs.Fields("date_created").value) %> ? <% end if if canEditPost(rs.Fields("user_id").value) = 1 then %> ?[edit]<% end if %>

<% rsname.close rsp.close end sub ' Draw All comments for a given object id and object type sub drawComments(object_id, object_type) RESPONSE.WRITE("

Comments:") ' Create the recordset dim sql dim show_deleted ' Detect any null values that might cause the SQL to fail if object_id = "" then exit sub end if if canCreateModPost() = 1 then 'show_deleted = 1 show_deleted = 0 ' let's hide deleted ones for now end if ' construct the sql for non-deleted and all posts. if show_deleted = 0 then sql = "Select * FROM COMMENTS where post_id = " & object_id sql = sql & " AND parent_type='" & object_type & "'" sql = sql & " AND deleted='0'" sql = sql & " ORDER BY comment_id" else sql = "Select * FROM COMMENTS where post_id = " & object_id sql = sql & " AND parent_type='" & object_type & "'" sql = sql & " ORDER BY comment_id" end if rs.Open sql, conn ' Display message and exit if post does not exist. if rs.eof then RESPONSE.WRITE(" - No comments yet, why not post one!
") rs.close RESPONSE.WRITE("View all site comments
") exit sub end if dim count do until rs.EOF if count mod 2 = 0 then RESPONSE.WRITE("
") else RESPONSE.WRITE("
") end if call drawComment(rs.Fields("comment_id").value) RESPONSE.WRITE("
") count = count + 1 rs.MoveNext loop RESPONSE.WRITE("View all site comments
") rs.close end sub ' 2007.01.07 draw a comment given a comment id. sub drawComment(comment_id) rsp.Open "Select * FROM COMMENTS where comment_id = " & comment_id , conn RESPONSE.WRITE("

On " & createDateString(rsp.Fields("date_created").value)) RESPONSE.WRITE(" " & rsp.Fields("user_name").value & " wrote:") RESPONSE.WRITE("

" & rsp.Fields("body").value) if rsp.Fields("deleted").value = "1" then RESPONSE.WRITE("

COMMENT DELETED BY ADMIN") end if ' Draw button to allow admin user to delete this post. if canCreateModPost() = 1 then dim back_url back_url = curPageURLWithVariables() %>

<% end if if canCreateModPost() = 1 then dim delPostUrl delPostUrl = "action.asp?action=delete_comment&object_id=" & comment_id RESPONSE.WRITE("

DELETE POST") end if 'RESPONSE.WRITE("
?" & rsp.Fields("comment_id").value) 'RESPONSE.WRITE("
?" & rsp.Fields("post_id").value) 'RESPONSE.WRITE("
?" & rsp.Fields("user_id").value) 'RESPONSE.WRITE("
?" & rsp.Fields("user_name").value) 'RESPONSE.WRITE("
?" & rsp.Fields("body").value) 'RESPONSE.WRITE("
?" & createDateString(rsp.Fields("date_created").value)) 'RESPONSE.WRITE("
?" & rsp.Fields("deleted").value) rsp.close end sub ' 2007.01.07 Draw form used for submitting comments. ' if the global variable g_enableComments is false then it displays ' a message instead. sub drawCommentPostingForm(post_id, parent_type) dim back_url back_url = curPageURLWithVariables() if g_enableComments <> true then RESPONSE.WRITE("

Comment posting is currently disabled.") else RESPONSE.WRITE("

Post a comment:") %>

Name
Comment
<% end if end sub sub updateTagCountForAllTags dim sql sql = "Select distinct tag_string FROM TAGS" sql = sql & " where deleted <> '1' and object_type='IMAGE'" rs.Open sql, conn if rs.EOF then RESPONSE.WRITE("
updateTagCountForAllTags: No tags found.") rs.close exit sub end if do until rs.EOF call updateTagCount(rs.Fields("tag_string").value, "IMAGE") rs.MoveNext loop rs.close end sub sub updateTagCount(tag_string, object_type) dim sql sql = "SELECT count(tag_string) as tag_count FROM TAGS where tag_string='" & tag_string & "'" sql = sql & " and object_type='" & object_type & "'" 'RESPONSE.WRITE("
sql: " & sql) rsp.Open sql, conn if rsp.eof then 'RESPONSE.WRITE("
no Tags found for string:" & tag_string) rsp.close exit sub end if dim num_rows num_rows = rsp.Fields("tag_count").value 'RESPONSE.WRITE("
tag_count = " & rsp.Fields("tag_count").value & " for: " & tag_string) rsp.close ' Now determine if a row exists in TAG_COUNT for the tag. sql = "select 1 from TAG_COUNT where tag_string='" & tag_string & "'" sql = sql & " and object_type='" & object_type & "'" rsp.Open sql, conn dim row_exists if rsp.eof then RESPONSE.WRITE("
No TAG_COUNT row found for string:" & tag_string) row_exists = 0 else RESPONSE.WRITE("
TAG_COUNT row found for string:" & tag_string) row_exists = 1 end if rsp.close ' Update or insert tag count row. if row_exists = 0 then sql = "insert into TAG_COUNT (tag_string, object_type, tag_count)" sql = sql & " values ('" & tag_string & "','" & object_type & "'," & num_rows & ")" RESPONSE.WRITE("
SQL: " & sql) conn.Execute sql end if if row_exists = 1 then sql = "update TAG_COUNT set tag_count=" & num_rows sql = sql & " where tag_string='" & tag_string & "' and object_type='" & object_type & "'" RESPONSE.WRITE("
SQL: " & sql) conn.Execute sql end if 'insert into TAG_COUNT (tag_string, object_type, count) values ( 'imogen','IMAGE', 22) end sub %> <% ' Page constants const programs_folder = "programs/" dim passedInID dim passedInName dim passedInGalleryName dim global_program_id Dim programNameArray passedInID = 0 passedInName = "" global_program_id = 0 ' Check if an image id or name was passed in to the page. call detectPassedInID %> <% ' Connect to database. call databaseConnect(SERVER) set rs = SERVER.CREATEOBJECT("ADODB.recordset") set rsp = SERVER.CREATEOBJECT("ADODB.recordset") ' used for individual posts set rsname = SERVER.CREATEOBJECT("ADODB.recordset") ' Used to get username from user id %> <% call drawHeader %>
<% ' If logged in as admin, display editable fields. if canCreateModPost() then call displayEditableFields(passedInName) end if if passedInGalleryName <> "" then 'displayListOfProgramsForTag(passedInGalleryName) call buildProgramArrayFromTag(passedInGalleryName) end if if passedInGalleryName <> "" and passedInName = "" then RESPONSE.WRITE("

List of programs for tag: " & passedInGalleryName & "

") call displayListofPrograms_Grid end if ' If the passed in image name isn't empty, display the image. if passedInName <> "" then call display_program(passedInName) RESPONSE.WRITE("

") call displayProgramTags(1) ' draw image view count. ' gallery.asp?image_name=melt280.jpg hitcounturl = "programs.asp?program_name=" & passedInName RESPONSE.WRITE(" views:" & getEntityHitCount(hitcounturl, 1) ) ' Display comments call drawComments(global_program_id, "PROGRAM") ' Handle comment posting form call drawCommentPostingForm(global_program_id, "PROGRAM") RESPONSE.WRITE("
") end if ' If passed in gallery name and image name are empty, draw the main gallery page content. if passedInName = "" then %>

Coolbubble Java Programs

Here you can see a few java programs I have written over the last couple of years.

Most of them were done as experiments or visualisations of ideas I had.

Click on a tag to see all programs tagged with that word, or select a program name in the list below. <% RESPONSE.WRITE("

List of all programs

") call display_program_list RESPONSE.WRITE("

") end if %>

<% ' *** FUNCTIONS *** function getNameFromID_removed(user_id) rsname.Open "Select * FROM USERS where user_id = " & user_id , conn getNameFromID = rsname.Fields("user_name").value rsname.close end function function detectPassedInID passedInID = request.querystring("program_id") passedInName = request.querystring("program_name") passedInGalleryName = request.querystring("tag_name") end function sub display_program_list dim sql sql = "Select * FROM PROGRAMS" sql = sql & " where deleted <> '1'" 'RESPONSE.WRITE("
display_program: SQL:" & sql) rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("Error in display_program_list()") rsp.close exit sub end if dim url do until rsp.EOF' or counter = numtags url = "programs.asp?program_name=" & rsp.Fields("name").value RESPONSE.WRITE("" & rsp.Fields("name").value & " / ") counter = counter + 1 rsp.MoveNext loop RESPONSE.WRITE("
") rsp.close end sub ' Create an array of image names based on a tag. sub buildProgramArrayFromTag(tagString) dim sql sql = "Select name FROM PROGRAMS" sql = sql & " where program_id in (select object_id from TAGS where object_type='PROGRAM' AND tag_string='" & tagString & "' and deleted='0')" sql = sql & " and deleted = '0'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
Error, nothing found in buildProgramArrayFromTag") rsp.close exit sub end if programNameArray = rsp.GetRows() 'For iRowLoop = 0 to UBound(imageNameArray, 2) ' Response.Write(imageNameArray(0, iRowLoop) & "
") ' Response.Write("

") 'Next rsp.close end sub ' Draw most recent programs as thumbnails sub drawRecentProgramThumbnails(numProgs) dim sql sql = "Select name FROM PROGRAMS" sql = sql & " where deleted = '0'" sql = sql & " order by date_created desc" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
Error, nothing found in buildProgramArrayFromTag") rsp.close exit sub end if dim progCounter do until rsp.EOF or progCounter >= numProgs str_thumb = "" str = ""& str_thumb &"" RESPONSE.WRITE(str) progCounter = progCounter + 1 rsp.MoveNext loop rsp.close end sub ' Draw image thumbnails. sub displayListofPrograms_Grid dim columnCount, maxColumn maxColumn=4 RESPONSE.WRITE("
") for iRowLoop = 0 to UBound(programNameArray, 2) if columnCount = 0 then RESPONSE.WRITE("") end if RESPONSE.WRITE("") columnCount = columnCount + 1 if columnCount = maxColumn then columnCount = 0 RESPONSE.WRITE("") end if next RESPONSE.WRITE("

") fileName = programNameArray(0, iRowLoop) ' Create shorter version of the filename filenameSmall = fileName if LEN(filenameSmall) > 18 then filenameSmall = LEFT(filenameSmall,15) + "..." end if ' Construct thumbnail string. str_img_thumb = "" ' Construct the special values that are passed into the link. str_passed_in_values = "?program_name=" & fileName & "&tag_name=" & passedInGalleryName ' Construct final markup. str = ""& str_img_thumb & "
" & filenameSmall & "
" RESPONSE.WRITE(str) RESPONSE.WRITE("
") ' Add digg icon. RESPONSE.WRITE("") end sub sub displayListOfProgramsForTag(tagString) dim sql sql = "Select name FROM PROGRAMS where program_id in (select object_id from TAGS where object_type='PROGRAM' AND tag_string='" & tagString & "')" sql = sql & " and deleted = '0'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
displayListOfProgramsForTag: No programs found.") rsp.close exit sub end if do until rsp.EOF str_thumb = "" str = ""& str_thumb & rsp.Fields("name").value & "" RESPONSE.WRITE("
" & str) rsp.MoveNext loop rsp.close end sub sub display_program(program_name) dim sql sql = "Select * FROM PROGRAMS where name = '" & program_name & "' " sql = sql & "and deleted <> '1'" 'RESPONSE.WRITE("
display_program: SQL:" & sql) rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
display_program: object found:" & program_name) rsp.close exit sub end if dim program_id dim description dim input_info dim width dim height dim source_link dim date_created dim deleted ' Extract image details from record. program_id = rsp.Fields("program_id").value description = rsp.Fields("description").value input_info = rsp.Fields("input_info").value width = rsp.Fields("width").value height = rsp.Fields("height").value source_link = rsp.Fields("source_link").value date_created = rsp.Fields("date_created").value deleted = rsp.Fields("deleted").value global_program_id = program_id dim image_url image_url = program_folder & program_name ' Construct next and prev link urls. image_url_next = "programs.asp?tag_name=" & passedInGalleryName & "&program_name=" & getNameOfNextImage(program_name, 1 ) image_url_prev = "programs.asp?tag_name=" & passedInGalleryName & "&program_name=" & getNameOfNextImage(program_name, -1 ) ' ' dim program_html dim program_dimensions dim program_archive ' Create the table RESPONSE.WRITE("") ' Draw program name RESPONSE.WRITE("") ' Create program display html program_archive = " archive='" & programs_folder & program_name & ".jar'" program_dimensions = " height=" & height & " width=" & width program_html = "" program_html = program_html & "" ' Show the program java app RESPONSE.WRITE("") ' Display Next and previous links. RESPONSE.WRITE("") RESPONSE.WRITE("") 'RESPONSE.WRITE("") RESPONSE.WRITE("") 'RESPONSE.WRITE("") RESPONSE.WRITE("") RESPONSE.WRITE("

" & program_name & "

" & program_html & "
") RESPONSE.WRITE("<< prev") 'RESPONSE.WRITE("
") RESPONSE.WRITE("  next >>") RESPONSE.WRITE("
") ' Draw image notes. if description <> "" then RESPONSE.WRITE("
Description:

" & description & "") end if if input_info <> "" then RESPONSE.WRITE("

Input / controls:

" & input_info) RESPONSE.WRITE("
[You may have to click on the window to enable keyboard input]
") RESPONSE.WRITE("") else RESPONSE.WRITE("Non-Interactive") end if RESPONSE.WRITE("

") rsp.close end sub ' Display image tags. sub displayProgramTags(makeLinks) if global_program_id = "" then RESPONSE.WRITE("

global_program_id empty.") exit sub end if dim sql sql = "Select distinct tag_string, tag_id FROM TAGS" sql = sql & " WHERE object_type='PROGRAM'" sql = sql & " AND object_id=" & global_program_id sql = sql & " AND deleted = '0'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("

No tags found.") rsp.close exit sub end if dim url dim deletion_url RESPONSE.WRITE("

tags:") do until rsp.EOF 'RESPONSE.WRITE(" " & rsp.Fields("tag_string").value ) url = "programs.asp?tag_name=" & rsp.Fields("tag_string").value RESPONSE.WRITE("" & rsp.Fields("tag_string").value & " ") 'rsp.Fields("tag_id").value if canCreateModPost() then deletion_url = "[x]" RESPONSE.WRITE("" & deletion_url & " ") end if rsp.MoveNext loop rsp.close end sub ' return a string representing the next image in the gallery. ' updated to use an offset (so can be used for previous or next) function getNameOfNextImage(program_name, offset) if passedInGalleryName = "" then getNameOfNextImage = "" exit function end if numImagesInGallery = UBound(programNameArray, 2) cur_image_index = -1 for iRowLoop = 0 to numImagesInGallery if programNameArray(0, iRowLoop) = program_name then cur_image_index = iRowLoop end if next if cur_image_index = -1 then getNameOfNextImage = "" if cur_image_index+offset > numImagesInGallery then getNameOfNextImage = "" exit function end if if cur_image_index+offset < 0 then getNameOfNextImage = "" exit function end if getNameOfNextImage = programNameArray(0, cur_image_index+offset) end function sub displayMostPopularTags(numTags) dim sql sql = "Select tag_string, tag_count from TAG_COUNT" sql = sql & " where object_type = 'PROGRAM'" sql = sql & " order by tag_count DESC" 'RESPONSE.WRITE("
sql: " & sql) rsp.Open sql, conn if rsp.EOF then 'RESPONSE.WRITE("
displayMostPopularTags(): No tags found.") rsp.close exit sub end if dim url,counter RESPONSE.WRITE("

Most popular tags

") do until rsp.EOF or counter = numtags url = "programs.asp?tag_name=" & rsp.Fields("tag_string").value RESPONSE.WRITE("" & rsp.Fields("tag_string").value & " / ") counter = counter + 1 rsp.MoveNext loop RESPONSE.WRITE("
") rsp.close end sub sub displayEditableFields(program_name) dim sql sql = "Select * FROM PROGRAMS where name = '" & program_name & "' " sql = sql & "and deleted <> '1'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
displayEditableFields - Image not found") rsp.close exit sub end if dim program_id dim name dim description dim input_info dim width dim height dim source_link dim date_created dim deleted dim tags ' Extract image details from record. program_id = rsp.Fields("program_id").value name = rsp.Fields("name").value description = rsp.Fields("description").value input_info = rsp.Fields("input_info").value width = rsp.Fields("width").value height = rsp.Fields("height").value source_link = rsp.Fields("source_link").value date_created = rsp.Fields("date_created").value deleted = rsp.Fields("deleted").value tags = "" rsp.close ' Enable to debug. if 1=2 then RESPONSE.WRITE("
program_id: " & program_id) RESPONSE.WRITE("
name: " & name) RESPONSE.WRITE("
description: " & description) RESPONSE.WRITE("
input_info: " & input_info) RESPONSE.WRITE("
width: " & width) RESPONSE.WRITE("
height: " & height) RESPONSE.WRITE("
source_link: " & source_link) RESPONSE.WRITE("
date_created: " & date_created) RESPONSE.WRITE("
deleted: " & deleted) RESPONSE.WRITE("
tags: " & tags) end if %>
program_id
filename
description
input_info
width
height
source_link
tags
date_created
deleted
<% end sub sub drawAdvert %>

<% end sub %>