<%@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 image_folder = "image/" dim passedInID dim passedInName dim global_image_id Dim imageNameArray DIM imageNameArraySize passedInID = 0 passedInName = "" passedInGalleryName = "" ' 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 'displayListOfImagesForTag(passedInGalleryName) call buildImageArrayFromTag(passedInGalleryName) end if if passedInGalleryName <> "" and passedInName = "" then if imageNameArraySize < 1 then RESPONSE.WRITE("Gallery name or tag not found, no images to display.") else call displayListofImages_Grid RESPONSE.WRITE("
social Networking
") RESPONSE.WRITE("") end if end if ' If the passed in image name isn't empty, display the image. if passedInName <> "" then call display_image(passedInName) call displayImageTags(1) ' draw image view count. ' gallery.asp?image_name=melt280.jpg hitcounturl = "gallery.asp?image_name=" & passedInName RESPONSE.WRITE(" | views:" & getEntityHitCount(hitcounturl, 1) ) ' Display comments call drawComments(global_image_id, "IMAGE") ' Handle comment posting form call drawCommentPostingForm(global_image_id, "IMAGE") RESPONSE.WRITE("
") end if ' If passed in gallery name and image name are empty, draw the main gallery page content. if passedInGalleryName = "" and passedInName = "" then %>

Coolbubble gallery

Welcome to the new coolbubble gallery, the system has been updated to make it easier to find images and allows comment posting on images and other features. Please have a look around, I hope you find something interesting.

All images here were done by me [nick] over the last few years for various reasons. Many were made to post on a website called b3ta, some are drawings I have done in an attempt to learn to draw, and some were done as features for this website, like Milly and Rupe, Imogen, the Hidden Pictures and of course, Mos! <% call displayListofAllTags 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("image_id") passedInName = request.querystring("image_name") passedInGalleryName = request.querystring("gallery_name") 'RESPONSE.WRITE("
passedInID: " & passedInID) 'RESPONSE.WRITE("
passedInName: " & passedInName) end function sub display_image(image_name) dim sql sql = "Select * FROM IMAGES where filename = '" & image_name & "' " sql = sql & "and deleted <> '1'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
Image not found") rsp.close exit sub end if dim filename dim width dim height dim thumbnail dim description dim date_created dim deleted ' Extract image details from record. image_id = rsp.Fields("image_id").value filename = rsp.Fields("filename").value width = rsp.Fields("width").value height = rsp.Fields("height").value thumbnail = rsp.Fields("thumbnail").value description = rsp.Fields("description").value date_created = rsp.Fields("date_created").value deleted = rsp.Fields("deleted").value global_image_id = image_id dim image_url image_url = image_folder & filename ' Construct next and prev link urls. image_url_next = "gallery.asp?gallery_name=" & passedInGalleryName & "&image_name=" & getNameOfNextImage(image_name, 1 ) image_url_prev = "gallery.asp?gallery_name=" & passedInGalleryName & "&image_name=" & getNameOfNextImage(image_name, -1 ) ' draw image. RESPONSE.WRITE("
") RESPONSE.WRITE("") RESPONSE.WRITE("" ) RESPONSE.WRITE("") RESPONSE.WRITE("

" ) ' Display Next and previous links. RESPONSE.WRITE("<< prev") RESPONSE.WRITE("  next >>") RESPONSE.WRITE("
" & filename) if 1=2 then RESPONSE.WRITE("
image_id: " & image_id) RESPONSE.WRITE("
filename: " & filename) RESPONSE.WRITE("
width: " & width) RESPONSE.WRITE("
height: " & height) RESPONSE.WRITE("
thumbnail: " & thumbnail) RESPONSE.WRITE("
date_created: " & date_created) RESPONSE.WRITE("
deleted: " & deleted) end if ' Draw image notes. if description <> "" then RESPONSE.WRITE("

" & description) end if rsp.close end sub ' return a string representing the next image in the gallery. ' updated to use an offset (so can be used for both previous and next) function getNameOfNextImage(image_name, offset) if passedInGalleryName = "" then getNameOfNextImage = "" exit function end if ' check if the array is empty 'If (Not imageNameArray) = -1 Then ' Array is empty ' getNameOfNextImage = "" ' exit function 'end if if not IsArray(imageNameArray) then ' Array is empty getNameOfNextImage = "" exit function end if numImagesInGallery = UBound(imageNameArray, 2) cur_image_index = -1 for iRowLoop = 0 to numImagesInGallery if imageNameArray(0, iRowLoop) = image_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 = imageNameArray(0, cur_image_index+offset) end function sub displayPrevAndNext end sub sub displayListOfImagesForTag(tagString) dim sql sql = "Select filename FROM IMAGES where image_id in (select object_id from TAGS where object_type='IMAGE' AND tag_string='" & tagString & "')" sql = sql & " and deleted = '0'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
No images found found.") rsp.close exit sub end if do until rsp.EOF str_thumb = "" str = ""& str_thumb & rsp.Fields("filename").value & "" RESPONSE.WRITE("
" & str) rsp.MoveNext loop rsp.close end sub ' Create an array of image names based on a tag. sub buildImageArrayFromTag(tagString) dim sql sql = "Select filename FROM IMAGES" sql = sql & " where image_id in (select object_id from TAGS where object_type='IMAGE' " sql = sql & " AND tag_string='" & tagString & "' and deleted='0')" sql = sql & " and deleted = '0'" sql = sql & " ORDER by date_created desc" rsp.Open sql, conn if rsp.EOF then rsp.close 'RESPONSE.WRITE("
buildImageArrayFromTag - ERROR tag not found
" & str) imageNameArraySize = 0 exit sub end if imageNameArray = rsp.GetRows() imageNameArraySize = UBound(imageNameArray, 2) 'For iRowLoop = 0 to UBound(imageNameArray, 2) ' Response.Write(imageNameArray(0, iRowLoop) & "
") ' Response.Write("

") 'Next rsp.close end sub ' Draw image thumbnails. sub displayListofImages_Grid dim columnCount, maxColumn maxColumn=4 RESPONSE.WRITE("
") for iRowLoop = 0 to UBound(imageNameArray, 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 = imageNameArray(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 = "?image_name=" & fileName & "&gallery_name=" & passedInGalleryName ' Construct final markup. str = ""& str_img_thumb & "
" & filenameSmall & "" RESPONSE.WRITE(str) RESPONSE.WRITE("
") end sub sub displayImageTags(makeLinks) if global_image_id = "" then RESPONSE.WRITE("

global_image_id empty.") exit sub end if dim sql sql = "Select distinct tag_string, tag_id FROM TAGS" sql = sql & " WHERE object_type='IMAGE'" sql = sql & " AND object_id=" & global_image_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 = "gallery.asp?gallery_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 ' TAG CLOUD sub displayListofAllTags dim sql sql = "Select tag_string, tag_count from TAG_COUNT" sql = sql & " where object_type = 'IMAGE'" sql = sql & " order by tag_string" '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, fontSize, tagSum, tagAverage, tagmax do until rsp.EOF counter = counter + 1 tagSum = tagSum + rsp.Fields("tag_count").value if rsp.Fields("tag_count").value > tagmax then tagMax = rsp.Fields("tag_count").value end if rsp.MoveNext loop tagAverage = tagSum / counter ' Move back to start of records. rsp.movefirst RESPONSE.WRITE("

Tag Cloud

") RESPONSE.WRITE("

") do until rsp.EOF if rsp.Fields("tag_count").value > 2 then fontSize = calcFontSize(rsp.Fields("tag_count").value, tagmax) url = "gallery.asp?gallery_name=" & rsp.Fields("tag_string").value RESPONSE.WRITE(" " & rsp.Fields("tag_string").value & "  ") end if rsp.MoveNext loop RESPONSE.WRITE("


") rsp.close '  art  end sub function calcFontSize(tagCount, tagMax) dim maxFontSize dim minFontSize dim fs minFontSize = 10 maxFontSize = 38 'tagcount = (tagcount * tagcount) / (tagmax*tagmax) fs = minFontSize + ((tagCount / tagmax) * (maxFontSize - minFontSize)) if fs > maxfontsize then fs = maxfontsize end if calcFontSize = fs end function sub displayMostPopularTags(numTags) dim sql sql = "Select tag_string, tag_count from TAG_COUNT" sql = sql & " where object_type = 'IMAGE'" 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 = "gallery.asp?gallery_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(image_name) dim sql sql = "Select * FROM IMAGES where filename = '" & image_name & "' " sql = sql & "and deleted <> '1'" rsp.Open sql, conn if rsp.EOF then RESPONSE.WRITE("
Image not found") rsp.close exit sub end if dim image_id dim filename dim width dim height dim thumbnail dim description dim date_created dim deleted dim tags ' Extract image details from record. image_id = rsp.Fields("image_id").value filename = rsp.Fields("filename").value width = rsp.Fields("width").value height = rsp.Fields("height").value thumbnail = rsp.Fields("thumbnail").value description = rsp.Fields("description").value date_created = rsp.Fields("date_created").value deleted = rsp.Fields("deleted").value tags = "" rsp.close if 1=2 then RESPONSE.WRITE("
image_id: " & image_id) RESPONSE.WRITE("
filename: " & filename) RESPONSE.WRITE("
width: " & width) RESPONSE.WRITE("
height: " & height) RESPONSE.WRITE("
thumbnail: " & thumbnail) RESPONSE.WRITE("
date_created: " & date_created) RESPONSE.WRITE("
deleted: " & deleted) end if %>
image_id
filename
width
height
thumbnail
tags
description
date_created
deleted
<% end sub sub drawAdvert %>

<% end sub %>