Hva\' NU
Hvad er der galt her ?Microsoft JET Database Engine error \'80004005\'
Could not use \'\'; file already in use.
/m/post.asp, line 226
<%@ Language=VBScript %>
<% Response.Expires = 0 %>
<!-- #include file=\"name.inc\" //-->
<%
Dim strUsername, strEMail
If Request.Cookies(\"ASSFUsername\") <> \"\" Then strUsername = Request.Cookies(\"ASSFUsername\") Else Response.Redirect(\"login.asp\")
If Request.Cookies(\"ASSFEmail\") <> \"\" Then strEMail = Request.Cookies(\"ASSFEmail\") Else Response.Redirect(\"login.asp\")
%>
<html>
<head>
<title><%=ForumName%></title>
</head>
<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#000000\" vlink=\"#333333\" alink=\"#333333\">
<table width=\"800\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\" align=\"center\">
<tr>
<td> </td>
<td valign=\"bottom\" align=\"right\"><font face=\"Geneva, Arial, Helvetica, san-serif\" size=\"2\"><font size=\"2\"><a href=\"login.asp\"><font size=\"1\">Login</font></a><font size=\"1\">
|</font></font> <font size=\"1\"><a href=\"myaccount.asp\">Min konto</a> | <a href=\"register.asp\">Registrer</a></font></font>
</td>
</tr>
<tr>
<td colspan=\"2\"><font size=\"2\" face=\"Geneva, Arial, Helvetica, san-serif\"><a href=\"default.asp\"><%=ForumName%></a>/<a href=\"forum.asp?Cat=<%=Server.URLEncode(Request.QueryString(\"Cat\"))%>\"><%=Request.QueryString(\"Cat\")%></a>/Send
Hilsen </font></td>
</tr>
</table>
<br>
<table width=\"800\" border=\"1\" cellspacing=\"0\" cellpadding=\"0\" align=\"center\" bordercolor=\"#666666\" bgcolor=\"#CCCCCC\">
<tr>
<td>
<table width=\"800\" border=\"0\" cellspacing=\"0\" cellpadding=\"0\">
<tr>
<td width=\"15\"> </td>
<td>
<p><font face=\"Geneva, Arial, Helvetica, san-serif\" size=\"2\">
<%
If Request.Form.Count = 0 Then
If Request.QueryString(\"Cat\") <> \"\" Then
Call DisplayForm(Request.QueryString(\"Cat\"))
Else
Response.Write \"The correct information was not passed.\"
End If
Else
If Request.Form(\"Cat\") <> \"\" And Request.Form(\"txtMessage\") <> \"\" And Request.Form(\"txtSubject\") <> \"\" Then
Call AddtoDB(Request.Form(\"Cat\"), Request.Form(\"txtMessage\"), Request.Form(\"txtSubject\"))
Else
Response.Write \"The correct information was not passed.\"
End If
End If
Sub DisplayForm(strCat)
%>
</font></p>
<form name=\"frmPost\" method=\"post\" action=\"post.asp\">
<p><font face=\"Geneva, Arial, Helvetica, san-serif\" size=\"2\">Brugernavn:
<%= strUsername %><br>
E-mail: <%= strEmail %><br>
Overskrift:
<input type=\"text\" name=\"txtSubject\" maxlength=\"25\" size=\"30\">
<br>
Hilsen:<br>
<textarea name=\"txtMessage\" cols=\"40\" rows=\"6\" wrap=\"PHYSICAL\"></textarea>
<br>
<input type=\"hidden\" name=\"Cat\" value=\"<%= strCat %>\">
<input type=\"submit\" value=\"Send\" name=\"submit\">
</font></p>
</form>
<font face=\"Geneva, Arial, Helvetica, san-serif\" size=\"2\">
<%
End Sub
Function AddtoDB(strCat, txtMessage, txtSubject)
txtMessage = Replace(txtMessage, \"fuck\", \"f***\")
txtMessage = Replace(txtMessage, \"Fuck\", \"F***\")
txtMessage = Replace(txtMessage, \"shit\", \"s***\")
txtMessage = Replace(txtMessage, \"Shit\", \"S***\")
txtMessage = Replace(txtMessage, \"bitch\", \"b****\")
txtMessage = Replace(txtMessage, \"Bitch\", \"B****\")
txtMessage = Replace(txtMessage, \"ass\", \"a**\")
txtMessage = Replace(txtMessage, \"Ass\", \"A**\")
txtMessage = Replace(txtMessage, \"asshole\", \"a**h***\")
txtMessage = Replace(txtMessage, \"Asshole\", \"A**h***\")
txtMessage = Replace(txtMessage, \"hell\", \"h***\")
txtMessage = Replace(txtMessage, \"Hell\", \"H***\")
txtMessage = Replace(txtMessage, \"nigger\", \"n******\")
txtMessage = Replace(txtMessage, \"Nigger\", \"N******\")
txtMessage = Replace(txtMessage, \"nigga\", \"n****\")
txtMessage = Replace(txtMessage, \"Nigga\", \"N****\")
txtMessage = Replace(txtMessage, VbCrlf, \"<br>\")
txtSubject = Replace(txtSubject, \"fuck\", \"f***\")
txtSubject = Replace(txtSubject, \"Fuck\", \"F***\")
txtSubject = Replace(txtSubject, \"shit\", \"s***\")
txtSubject = Replace(txtSubject, \"Shit\", \"S***\")
txtSubject = Replace(txtSubject, \"bitch\", \"b****\")
txtSubject = Replace(txtSubject, \"Bitch\", \"B****\")
txtSubject = Replace(txtSubject, \"ass\", \"a**\")
txtSubject = Replace(txtSubject, \"Ass\", \"A**\")
txtSubject = Replace(txtSubject, \"asshole\", \"a**h***\")
txtSubject = Replace(txtSubject, \"Asshole\", \"A**h***\")
If Len(txtMessage) > 1020 Then
Response.Write \"Your message is longer than the 1020 charter limit.<br> Please press back and fix this.\"
Response.End
End If
If Len(txtMessage) > 255 Then
Dim txtMessage1
txtMessage1 = Right(txtMessage, Len(txtMessage) - 255)
txtMessage = Left(txtMessage, 255)
If Len(txtMessage1) > 255 Then
Dim txtMessage2
txtMessage2 = Right(txtMessage1, Len(txtMessage1) - 255)
txtMessage1 = Left(txtMessage1, 255)
If Len(txtMessage2) > 255 Then
Dim txtMessage3
txtMessage3 = Right(txtMessage2, Len(txtMessage2) - 255)
txtMessage2 = Left(txtMessage2, 255)
End If
End If
End If
Dim objForumConn, objForumRS, itmForum, strForumSQL
Set objForumConn = Server.CreateObject(\"ADODB.Connection\")
objForumConn.Provider = \"Microsoft.Jet.OLEDB.4.0\"
objForumConn.Open Server.MapPath(\"forum.mdb\")
strForumSQL = \"Select * From Forums\"
Set objForumRS = Server.CreateObject(\"ADODB.Recordset\")
objForumRS.Open strForumSQL, objForumConn, 1, 2
If Not objForumRS.EOF Then
objForumRS.AddNew
objForumRS.Fields(\"Category\").Value = strCat
objForumRS.Fields(\"IdNum\").Value = RecordNum
objForumRS.Fields(\"Subject\").Value = txtSubject
objForumRS.Fields(\"Message\").Value = txtMessage
If txtMessage1 <> \"\" Then
objForumRS.Fields(\"Message1\").Value = txtMessage1
If txtMessage2 <> \"\" Then
objForumRS.Fields(\"Message2\").Value = txtMessage2
If txtMessage3 <> \"\" Then
objForumRS.Fields(\"Message3\").Value = txtMessage3
End If
End If
End If
objForumRS.Fields(\"Username\").Value = CStr(Request.Cookies(\"ASSFUsername\"))
objForumRS.Fields(\"Email\").Value = CStr(Request.Cookies(\"ASSFEmail\"))
objForumRS.Fields(\"Date\").Value = Now()
objForumRS.Fields(\"Replies\").Value = \"0\"
objForumRS.Fields(\"Locked\").Value = \"False\"
objForumRS.Update
Call AddPost(objForumRS.Fields(\"Username\").Value)
Else
objForumRS.AddNew
objForumRS.Fields(\"Category\").Value = strCat
objForumRS.Fields(\"IdNum\").Value = RecordNum
objForumRS.Fields(\"Subject\").Value = txtSubject
objForumRS.Fields(\"Message\").Value = txtMessage
If txtMessage1 <> \"\" Then
objForumRS.Fields(\"Message1\").Value = txtMessage1
If txtMessage2 <> \"\" Then
objForumRS.Fields(\"Message2\").Value = txtMessage2
If txtMessage3 <> \"\" Then
objForumRS.Fields(\"Message3\").Value = txtMessage3
End If
End If
End If
objForumRS.Fields(\"Username\").Value = CStr(Request.Cookies(\"ASSFUsername\"))
objForumRS.Fields(\"Email\").Value = CStr(Request.Cookies(\"ASSFEmail\"))
objForumRS.Fields(\"Date\").Value = Now()
objForumRS.Fields(\"Replies\").Value = \"0\"
objForumRS.Fields(\"Locked\").Value = \"False\"
objForumRS.Update
Call AddPost(objForumRS.Fields(\"Username\").Value)
End If
objForumRS.Close
objForumConn.Close
Set objForumRS = Nothing
Set objForumConn = Nothing
Call AddTopic(strCat)
Response.Redirect(\"forum.asp?Cat=\" & strCat)
End Function
Sub AddTopic(strCat)
Dim objTopicConn, objTopicRS, strTopicSQL, intTmp
Set objTopicConn = Server.CreateObject(\"ADODB.Connection\")
objTopicConn.Provider = \"Microsoft.Jet.OLEDB.4.0\"
objTopicConn.Open Server.MapPath(\"forum.mdb\")
strTopicSQL = \"Select Topics, Date From Categories Where Name=\'\" & strCat & \"\'\"
Set objTopicRS = Server.CreateObject(\"ADODB.Recordset\")
objTopicRS.Open strTopicSQL, objTopicConn, 1, 2
If Not objTopicRS.EOF Then
intTmp = objTopicRS.Fields(\"Topics\").Value
End If
intTmp = intTmp + 1
objTopicRS.Fields(\"Topics\").Value = CStr(intTmp)
objTopicRS.Fields(\"Date\").Value = Now()
objTopicRS.Update
objTopicRS.Close
objTopicConn.Close
Set objTopicRS = Nothing
Set objTopicConn = Nothing
End Sub
Function RecordNum()
Dim objIdNumConn, objIdNumRS, strIdNumSQL, strTemp
Set objIdNumConn = Server.CreateObject(\"ADODB.Connection\")
objIdNumConn.Provider = \"Microsoft.Jet.OLEDB.4.0\"
objIdNumConn.Open Server.MapPath(\"forum.mdb\")\'dette er linie 226\'
strIdNumSQL = \"Select * From MainIdNum Where Category=\'\" & Request.Form(\"Cat\") & \"\'\"
Set objIdNumRS = Server.CreateObject(\"ADODB.Recordset\")
objIdNumRS.Open strIdNumSQL, objIdNumConn, 1, 2
If Not objIdNumRS.EOF Then
strTemp = objIdNumRS.Fields(\"IdNum\").Value
End If
strTemp = strTemp + 1
objIdNumRS.Fields(\"IdNum\").Value = CStr(strTemp)
objIdNumRS.Update
RecordNum = CStr(strTemp)
objIdNumRS.Close
objIdNumConn.Close
Set objIdNumRS = Nothing
Set objIdNumConn = Nothing
End Function
Sub AddPost(strUser)
Dim objTPostConn, objTPostRS, strTPostSQL, str_Posts
Set objTPostConn = Server.CreateObject(\"ADODB.Connection\")
objTPostConn.Provider = \"Microsoft.Jet.OLEDB.4.0\"
objTPostConn.Open Server.MapPath(\"user.mdb\")
strTPostSQL = \"Select * From Users Where Username=\'\" & strUser & \"\'\"
Set objTPostRS = Server.CreateObject(\"ADODB.Recordset\")
objTPostRS.Open strTPostSQL, objTPostConn, 1, 2
If Not objTPostRS.EOF Then
strPosts = objTPostRS.Fields(\"T_Posts\").Value
If Not strPosts <> \"\" Then strPosts = 0
strPosts = CInt(strPosts) + 1
objTPostRS.Fields(\"T_Posts\").Value = CStr(strPosts)
objTPostRS.Update
End If
objTPostRS.Close
objTPostConn.Close
Set objTPostRS = Nothing
Set objTPostConn = Nothing
End Sub
%>
</font></td>
</tr>
</table>
</td>
</tr>
</table>
<p align=\"center\"><br>
</p>
</body>
</html>
