<% function tidydate(thedate) tidydate=day(thedate) & " " & left(monthname(month(thedate)),3) & " " & year(thedate) end function ' this function is used in comments, inserts appropriate html chars for some special characters ' that didn't display correctly through xmlhttp. Call it a hack if you will function insChars(strString) strArray1 = array("ó","ú","á","é","í","æ","ö","þ","ð","ý","å") strArray2 = array("ó","ú","á","é","í","æ","ö","þ","ð","ý","å") strReturn = strString for i = 0 to uBound(strArray1) strReturn = replace(LCase(strReturn), strArray1(i) , strArray2(i)) next insChars = strReturn end function ' ****************************************************************************************** ' added 16/03/06: sql injection prevention functions ' usage - ' stripQuotes(stringToClean) - optional, if we want to keep quotes ' sanitize(stringToClean) ' ****************************************************************************************** function stripQuotes(strWords) stripQuotes = replace(strWords, "'", "''") end function function sanitize(strWords) dim badChars dim newChars badChars = array("select","union", "drop", ";", "--", "insert", "delete", "xp_", "#", "%", "&", "'", "(", ")", "/", "\", ":", ";", "<", ">", "=", "[", "]", "?", "`", "|") newChars = strWords for i = 0 to uBound(badChars) newChars = replace(LCase(newChars), LCase(badChars(i)) , "") next sanitize = newChars end function ' ****************************************************************************************** function getRecentPosts() strSQL = "SELECT TOP 10 * FROM T_WEBLOG WHERE b_published = true ORDER BY b_date DESC, b_time DESC" Set Rs = Server.CreateObject("ADODB.Recordset") Rs.ActiveConnection = strConn Rs.Source = strSQL Rs.CursorType = 0 Rs.CursorLocation = 2 Rs.LockType = 1 Rs.Open() If Not Rs.EOF Then response.Write("") end if end function Sub GetBlogs() if intTopCount = null Then intTopCount = 3 end if if intDisplayMode = null Then intDisplayMode = 3 end if Select case intDisplayMode Case "",0 strSQL = "SELECT * FROM T_WEBLOG WHERE b_published = true ORDER BY b_date DESC, b_time DESC" Case 1 weekCode = DateAdd("d",-7,Date()) weekCode = dateToInt(weekCode) strSQL = "SELECT * FROM T_WEBLOG WHERE "&weekCode&" < b_date AND b_published = true ORDER BY b_date DESC, b_time DESC" Case 2 montCode = DateAdd("d",-30,Date()) montCode = dateToInt(montCode) strSQL = "SELECT * FROM T_WEBLOG WHERE "&montCode&" < b_date AND b_published = true ORDER BY b_date DESC, b_time DESC" Case 3 strSQL = "select TOP "&Cint(intTopCount)&" * FROM (SELECT * FROM T_WEBLOG WHERE b_published = true ORDER BY b_date DESC, b_time DESC)" End Select If request.QueryString("view") = "archives" then intMonth = request.QueryString("month") ' check for injection attempt if not isnumeric(intMonth) then response.Write("error! Bad month value!!") response.End() end if intYear = request.QueryString("year") strSQL = "SELECT * FROM T_WEBLOG WHERE b_year = " & sanitize( intYear ) & " AND b_month = " & sanitize( intMonth ) & " AND b_published = true ORDER BY ID DESC" End if If request.QueryString("view") = "day" then strDate = request.QueryString("blogDate") strDate = DateToInt(strDate) strSQL = "SELECT * FROM T_WEBLOG WHERE b_date = " & sanitize( strDate ) & " AND b_published = true ORDER BY ID DESC" else if request.QueryString("view") = "plink" then strSQL = "SELECT * FROM T_WEBLOG WHERE id = " & sanitize( request.QueryString("id") ) end if end if Set Rs = Server.CreateObject("ADODB.Recordset") Rs.ActiveConnection = strConn Rs.Source = strSQL Rs.CursorType = 0 Rs.CursorLocation = 2 Rs.LockType = 1 Rs.Open() If Not rs.EOF Then rs.MoveFirst while not rs.EOF %>

<%=rs("b_headline")%>

<%=DisplayDate(IntToDate(rs("b_date")))%>

<%=rs("b_content")%>
">
" style="display:none; visibility:hidden">
<% rs.MoveNext wend else response.Write("
no blogs have been published ...
") End if %> <% rs.Close set rs = Nothing End Sub %> <% Sub getArchives() 'strSQL = "SELECT DISTINCT Month(b_date) as b_month, Year(b_date) as b_year FROM T_WEBLOG WHERE b_published = true ORDER BY Year(b_date) DESC, Month(b_Date) DESC" strSQL = "SELECT DISTINCT b_month, b_year FROM T_WEBLOG WHERE b_published = true ORDER BY b_year DESC, b_month DESC" Set rsDates = Server.CreateObject("ADODB.Recordset") rsDates.ActiveConnection = strConn rsDates.Source = strSQL rsDates.CursorType = 0 rsDates.CursorLocation = 2 rsDates.LockType = 1 rsDates.Open() IF Not rsDates.EOF Then response.Write("") End If rsDates.Close set rsDates = Nothing End Sub %> <% Sub GetCommentLink(bID) if boolApproveComments Then strSQL = "SELECT Count(*) AS CommentCount FROM T_COMMENTS WHERE ((isApproved = true) AND ((T_COMMENTS.c_bID_fk)=" & bID & "))" else strSQL = "SELECT Count(*) AS CommentCount FROM T_COMMENTS WHERE (((T_COMMENTS.c_bID_fk)=" & bID & "))" end if Set rsC_Count = Server.CreateObject("ADODB.Recordset") rsC_Count.ActiveConnection = strConn rsC_Count.Source = strSQL rsC_Count.CursorType = 0 rsC_Count.CursorLocation = 2 rsC_Count.LockType = 1 rsC_Count.Open() 'Response.Write("" & strCommentText & "(" & rsC_Count("CommentCount") & ")") Response.Write("" & strCommentText & "(" & rsC_Count("CommentCount") & ")") rsC_Count.close Set rsC_Count = Nothing End Sub %> <% Sub GetComments(bID) strbID = sanitize( bID ) if boolApproveComments Then strSQL = "SELECT * FROM T_COMMENTS WHERE c_bID_fk=" & bID &" AND isApproved = true ORDER BY id asc" else strSQL = "SELECT * FROM T_COMMENTS WHERE c_bID_fk=" & bID &" ORDER BY id asc" end if Set rsComments = Server.CreateObject("ADODB.Recordset") rsComments.ActiveConnection = strConn rsComments.Source = strSQL rsComments.CursorType = 0 rsComments.CursorLocation = 2 rsComments.LockType = 1 rsComments.Open() %> <% If Not rsComments.EOF Then rsComments.MoveFirst While Not rsComments.EOF %> <% thisComment = rsComments("c_content") thisUrl = rsComments("c_url") thisUrl = replace(thisUrl,"http://","") thisUrl = "http://" & thisUrl ' insert emoticons */ IISfolder = server.MapPath("emoticons/") Set fso = Server.CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(IISfolder) Set Files = folder.Files For Each File in Files strEmoticon = File.name strEmoticon = replace(strEmoticon,".gif","") strEmoticon = "!" & strEmoticon & "!" if strEmoticon <> "Thumbs.db" Then thisComment = replace(thisComment,strEmoticon,"") End if Next %> <% rsComments.MoveNext Wend else %> <% End if %>

Simpleblog 2.3
 
 
<%=thisComment%>
<% if rsComments("c_name") <> "" Then response.Write(rsComments("c_name")) else response.Write(strNameEmpty) end if %> <% if rsComments("c_email") <> "" Then %> | "><%=rsComments("c_email")%> <% end if %> <% if rsComments("c_url") <> "" Then %> | <%=rsComments("c_url")%> <% end if %> | <%=tidydate(rsComments("c_time"))%> @ <%=formatdatetime(rsComments("c_time"), vbshorttime)%>
 
<%=strNoComments%>
 
Name
">
Email
">
URL
">
Comment
<% call getEmoticons()%>
">
<% End Sub %> <% Sub CommentsGet(bID) strbID = sanitize( bID ) if boolApproveComments Then strSQL = "SELECT * FROM T_COMMENTS WHERE c_bID_fk=" & bID &" AND isApproved = true ORDER BY id asc" else strSQL = "SELECT * FROM T_COMMENTS WHERE c_bID_fk=" & bID &" ORDER BY id asc" end if iCommImage = 1 Set rsComments = Server.CreateObject("ADODB.Recordset") rsComments.ActiveConnection = strConn rsComments.Source = strSQL rsComments.CursorType = 0 rsComments.CursorLocation = 2 rsComments.LockType = 1 rsComments.Open() %>

comments

<% If Not rsComments.EOF Then rsComments.MoveFirst While Not rsComments.EOF thisComment = insChars(rsComments("c_content")) if rsComments("c_name") <> "" Then thisCName = insChars(rsComments("c_name")) else thisCName = insChars(strNameEmpty) end if thisUrl = rsComments("c_url") thisUrl = replace(thisUrl,"http://","") thisUrl = "http://" & thisUrl ' insert emoticons */ IISfolder = server.MapPath("emoticons/") Set fso = Server.CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(IISfolder) Set Files = folder.Files For Each File in Files strEmoticon = File.name strEmoticon = replace(strEmoticon,".gif","") strEmoticon = "!" & strEmoticon & "!" if strEmoticon <> "Thumbs.db" Then thisComment = replace(thisComment,strEmoticon,"") End if Next if iCommImage = 1 Then strAvatar = "warhol.gif" iCommImage = 2 else strAvatar = "nashville.gif" iCommImage = 1 end if %>
<%=thisCName %> <% if rsComments("c_url") <> "" Then %> | <%=rsComments("c_url")%> <% end if %> ( <%=tidydate(rsComments("c_time"))%> @ <%=formatdatetime(rsComments("c_time"), vbshorttime)%> )
<%=thisComment%>
<% rsComments.MoveNext Wend else %>
<%=strNoComments%>
<% End if %>

ADD YOUR COMMENT

Name
" onfocus="this.className='selected';" onblur="this.className='';">
Email
" onfocus="this.className='selected';" onblur="this.className='';">
URL
" onfocus="this.className='selected';" onblur="this.className='';">
Comment

<% call getEmoticons()%>
">
<% End Sub %> <% Sub InsertComment() bID = request.Form("id") strName = request.Form("name") strEmail = request.Form("email") strUrl = request.Form("url") strComment = request.Form("main") strComment = replace(strComment,"'","''") strComment = replace(strComment,vbCrLf,"!br!") strComment = sanitize( strComment ) strComment = replace(strComment,"!br!","
") str_userIP = request.Form("userIP") 'create cookies to store user info */ Response.Cookies("visitorName") = strName Response.Cookies("visitorEmail") = strEmail Response.Cookies("visitorUrl") = strUrl Response.Cookies("visitorName").Expires = Date + 120 Response.Cookies("visitorEmail").Expires = Date + 120 Response.Cookies("visitorUrl").Expires = Date + 120 ' insert Comment */ strSQL = "INSERT INTO T_COMMENTS(c_content, c_name, c_email, c_url, c_bID_fk,ip) VALUES ('" & strComment & "','" & sanitize( strName ) & "','" & sanitize( strEmail ) & "','" & sanitize( strUrl )& "'," & sanitize( bID )& ",'"&str_userIP&"')" Set MyConn = Server.CreateObject("ADODB.Connection") MyConn.Open strConn MyConn.Execute(strSQL) MyConn.Close Set MyConn = Nothing response.Redirect("default.asp?view=plink&id=" & bID & "&comments=1") %> <% End Sub %> <% Sub getEmoticons() eCount = 0 IISfolder = server.MapPath("emoticons/") Set fso = Server.CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(IISfolder) Set Files = folder.Files For Each File in Files strEmoticon = File.name if strEmoticon <> "Thumbs.db" Then response.Write("&replace(strEmoticon,") eCount = eCount + 1 If eCount = 15 Then response.Write("
") eCount = 0 else response.Write(" ") end If End if Next End Sub Function blogCalendar() Dim rs_cal Dim rs_cal_numRows Set rs_cal = Server.CreateObject("ADODB.Recordset") rs_cal.ActiveConnection = strConn rs_cal.Source = "SELECT b_date FROM T_WEBLOG WHERE b_published = true" rs_cal.CursorType = 0 rs_cal.CursorLocation = 2 rs_cal.LockType = 1 rs_cal.Open() rs_cal_numRows = 0 If Request("blogDate") <> "" Then blogDate = Request("blogDate") 'blogDate = intToDate(Request("blogDate")) blogDate = DateValue(blogDate) blogDate = Month(blogDate) & "/" & Day(blogDate) & "/" & Year(blogDate) Else blogDate = date() End if if request.QueryString("view") = "archives" Then blogDate = request.QueryString("month") & "/" & Day(Now()) & "/" & request.QueryString("year") End if CurrentMonth = Month(blogDate) CurrentMonthName = MonthName(CurrentMonth) Session.lcid = intDisplayLCID CurrentMonthName = MonthName(CurrentMonth) session.LCID = InitLCID CurrentYear = Year(blogDate) FirstDayDate = DateSerial(CurrentYear, CurrentMonth, 1) FirstDay = WeekDay(FirstDayDate, 0) CurrentDay = FirstDayDate Dim tmpHTML tmpHTML="" tmpHTML = tmpHTML & "
" & Chr(10) tmpHTML = tmpHTML & "" & Chr(10) tmpHTML = tmpHTML & "" & Chr(10) & "" & Chr(10) & "" Response.Write(tmpHTML) For DayLoop = 1 to 7 Response.Write("" & Chr(10)) Next Response.Write("" & Chr(10) & "") If FirstDay <> 1 Then Response.Write("" & Chr(10)) End if DayCounter = FirstDay CorrectMonth = True Do While CorrectMonth = True isEvent = FALSE rs_cal.filter = 0 Dim iCheck Dim chkStr chkStr = (rs_cal.Fields.Item("b_date").Name) iCheck = CurrentDay iCheck = dateToInt(iCheck) rs_cal.filter = chkStr & "=" & (iCheck) If not(rs_cal.EOF) Then isEvent = TRUE If CurrentDay = blogDate Then Response.Write("" & Chr(10)) Else Response.Write(Day(CurrentDay) & "" & Chr(10)) End If DayCounter = DayCounter + 1 If DayCounter > 7 Then DayCounter = 1 Response.Write("" & Chr(10)) Response.Write(" CurrentMonth Then Response.Write(" class=""lastweek""") End If Response.Write(">" & Chr(10)) End if CurrentDay = DateAdd("d", 1, CurrentDay) If Month(CurrentDay) <> CurrentMonth then CorrectMonth = False End if Loop IF DayCounter <> 1 Then Response.Write("") Else Response.Write("") End if Response.Write("" & Chr(10) & "
" & Chr(10) strBackMonth = Month(DateAdd("m",-1,blogDate)) strBackYear = Year(blogDate) if strBackMonth = 12 Then strBackYear = Year(DateAdd("yyyy",-1,blogDate)) end if strFwdMonth = Month(DateAdd("m",1,blogDate)) strFwdYear = Year(blogDate) if strFwdMonth = 1 Then strFwdYear = Year(DateAdd("yyyy",1,blogDate)) end if tmpHTML = tmpHTML & "<< " tmpHTML = tmpHTML & CurrentMonthName & " " & CurrentYear tmpHTML = tmpHTML & " >>" tmpHTML = tmpHTML & "
" & WeekDayName(Dayloop, True, 0) & "
 ") Else Response.Write("") End if If isEvent = TRUE Then useDate = Month(CurrentDay) & "/" & Day(CurrentDay) & "/" & Year(CurrentDay) Response.Write("" & Day(CurrentDay)& "") Response.Write("
  
" & Chr(10)) rs_cal.Close() Set rs_cal = Nothing End Function %> <% '/* poll functions */ %> <% Sub GetCurrentPoll() strSQL = "SELECT ID FROM T_POLLS WHERE pActive = true" Set Rs = Server.CreateObject("ADODB.Recordset") Rs.ActiveConnection = strConn Rs.Source = strSQL Rs.CursorType = 0 Rs.CursorLocation = 2 Rs.LockType = 1 Rs.Open() If Not Rs.EOF Then intActiveID = Rs("id") End if Rs.Close Set Rs = Nothing ' check if user wants to view current results */ if request.QueryString("poll") = "currentResults" Then call GetPollResults() else ' check if user can answer more than once */ if strPollAllowMultiple = false Then ' if not, check if user has already answered */ if Request.Cookies("poll"&intActiveID) = "done" Then call GetPollResults() else ' get the current poll questions if user can answer more than once */ call GetPollQuestions() end if else call GetPollQuestions() End if End if End Sub %> <% Sub GetPollResults() strSQL = "SELECT * FROM V_RESULTS WHERE pActive = true ORDER BY icount DESC" Set Rs = Server.CreateObject("ADODB.Recordset") Rs.ActiveConnection = strConn Rs.Source = strSQL Rs.CursorType = 0 Rs.CursorLocation = 2 Rs.LockType = 1 Rs.Open() 'get total count */ strCount = 0 if not Rs.EOF Then Rs.MoveFirst While Not Rs.EOF strCount = strCount + Rs("icount") Rs.MoveNext Wend Rs.MoveFirst %> <% Rs.MoveFirst While Not Rs.EOF ' get current percent */ if Rs("icount") = 0 Then thisPercent = "0" thisTableWidth = "0" else thisPercent = Round ( Rs("icount") / strCount * 100 , 1 ) thisTableWidth = Round ( Rs("icount") / strCount * 100 , 0 ) end if %> <% Rs.MoveNext Wend %>
<%=Rs("pName")%>
 
 <%=thisPercent%>% (<%=Rs("icount")%>)
<%=Rs("answer")%>
 
<%=strPollText_votes%>:<%=strCount%>
<% End if End Sub %> <% Sub GetPollQuestions() %> <% strSQL = "SELECT * FROM V_RESULTS WHERE pActive = true" Set Rs = Server.CreateObject("ADODB.Recordset") Rs.ActiveConnection = strConn Rs.Source = strSQL Rs.CursorType = 0 Rs.CursorLocation = 2 Rs.LockType = 1 Rs.Open() If Not Rs.EOF Then strpID = Rs("pID") End if 'get total count */ strCount = 0 If Not Rs.EOF Then Rs.MoveFirst While Not Rs.EOF strCount = strCount + Rs("icount") Rs.MoveNext Wend Rs.MoveFirst %>
<% Rs.MoveFirst While Not Rs.EOF ' get current percent */ if Not Rs("icount") = null Then thisPercent = Round ( Rs("icount") / strCount * 100 , 1 ) thisTableWidth = Round ( Rs("icount") / strCount * 100 , 0 ) else thisPercent = "0" thisTableWidth = "0" end if %> <% Rs.MoveNext Wend %> <% If Request.Querystring <> "" Then tmpUrl = Request.ServerVariables("SCRIPT_NAME")&"?"&Request.Querystring&"&poll=currentResults" else tmpUrl = "?poll=currentResults" end if %>
<%=Rs("pName")%>
 
" /> <%=Rs("answer")%>
 

<%=strPollText_viewRes%>
<% else %> <% end if %> <% End Sub %>