MegaBBS forum. Omskrivning af upload komponent
Hej.Jeg har sat et MegaBBS forum ( http://www.pd9soft.com/ ) op, men det bruger en eller anden upload funktion som jeg ikke kender.
hvis filerne er over 200KB så fejler uploaden pga. settings i metabase.xml under AspMaxRequestEntityAllowed
Hosting selskap vil ikke ændre denne metabasen, selvom dette kan gøres på hvert enkelt website, og også uden at måtte reeboote serveren :-/
Så spørgsmålet er om der er nogen herinde som kan se hvad jeg må forandre for at flette dette script ind til at uploade med.
******************************
******************************
set upl = Server.CreateObject("SoftArtisans.FileUp")
upl.Path = Server.MapPath(".")
if (upl.IsEmpty) then
Response.write "Error: No files detected!"
elseif (upl.ContentDisposition <> "form-data") then
Response.write "
Error: Upload failed!"
else
Response.write "File is uploadet."
on error resume next
upl.Save
end if
*****************************
*****************************
Ovenstående funger upåklageligt på serveren.
attach-file.asp er siden hvor man vælger fil.
Efter hvad jeg kan se, så er det på linje 91 at den uploader :
<%@ CodePage=65001 Language="VBScript"%>
<% Option Explicit %>
<!-- #include file="../includes/include.asp"-->
<!-- #include file="../includes/include-forums.asp"-->
<!-- #include file="../includes/include-upload.asp" -->
<% sBBSLangPage = "attach-file"
BBS.SetupBBS
server.scripttimeout = 600
dim iMessageID, vMessageInfo, vThreadInfo, vForumInfo, vCategoryInfo, sAttachmentID, iMaxFileSize, bError, sDeleteForm, iEditTime, Uploader, SQL, File
dim bEditOwn, bEditOthers, iAttachmentOrder, iStartPos, iNewPos, iAttachmentID, sError, sGuid, iCount, vFiles, index
bError = False
iMessageID = request.querystring("mid")
vMessageInfo = Forum.GetMessageInfo(iMessageID)
vThreadInfo = Forum.GetThreadInfo(vMessageInfo(MI_ThreadID))
vForumInfo = Forum.GetForumInfo(vThreadInfo(TI_ForumID))
vCategoryInfo= BBS.GetCategoryInfo(vForumInfo(FI_CategoryID))
iAttachmentID= request.querystring("attachmentid")
bEditOwn = BBS.HasPermission(PERM_forumeditown, vForumInfo(FI_ForumID)) and (vMessageInfo(MI_MemberID) = iBBSMemberID)
bEditOthers = BBS.HasPermission(PERM_forumeditothers, vForumInfo(FI_ForumID)) and (vMessageInfo(MI_MemberID) <> iBBSMemberID)
if not(bEditOwn or bEditOthers) then response.redirect sBBSForumRoot & "/forums/forum-view.asp?fid=" & vThreadInfo(TI_ForumID)
if vForumInfo(FI_ForumID) = -1 or vThreadInfo(TI_ThreadID) = -1 then response.redirect sBBSForumRoot & "/index.asp"
if not(BBS.HasPermission(PERM_forumattach, vForumInfo(FI_ForumID))) then response.redirect sBBSForumRoot & "/forums/forum-view.asp?forumid=" & vForumInfo(FI_ForumID)
if vThreadInfo(TI_Closed) = 1 and not(BBS.HasPermission(PERM_forumfreeze, vForumInfo(FI_ForumID))) then response.redirect "thread-view.asp?tid=" & vThreadInfo(TI_ThreadID)
iEditTime = BBS.LookupPermission(MODULE_FORUMS, BBS.GetUserlevel(MODULE_Forums, vForumInfo(FI_ForumID)), PERM_forummaxedittime, vForumInfo(FI_ForumID))
if iEditTime > 0 then if DateDiff("n",vMessageInfo(MI_DatePosted), now) > 30 then dictEnvironment("V-ERROR") = dictEnvironment("V-ERROR") & dictLanguage("POST-18") & " " & iEditTime & " " & dictLanguage("POST-19") & "<br/>"
' Check the maximum upload size
iMaxFileSize = BBS.LookupPermission(MODULE_Forums, BBS.GetUserlevel(MODULE_Forums, vForumInfo(FI_ForumID)), PERM_forumattachsize, vForumInfo(FI_ForumID))
iMaxFileSize = iMaxFileSize * 1024
dictEnvironment("V-MAXFILESIZE") = iMaxFileSize
BBS.SetScheme(vCategoryInfo(CA_CategoryID))
'==================
' REPAIR SORTORDERS
'==================
if request.querystring("repair") = "true" then
rsMaster.open "select attachmentid, sortorder from attachments where messageid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & " order by filename asc", dbConnection, adOpenStatic, adLockOptimistic
index = 1
do until rsMaster.EOF
rsMaster.fields("sortorder").value = index
rsMaster.Update
index = index + 1
rsMaster.MoveNext
loop
rsMaster.close
end if
'===============
' MOVE AN ATTACHMENT
'===============
if request.querystring("move") = "true" and BBS.ValidateNumeric(iAttachmentID) > 0 then
rsMaster.open "select attachmentid, sortorder from attachments where attachmentid=" & BBS.ValidateNumeric(iAttachmentID), dbConnection, adOpenStatic, adLockOptimistic
iStartPos = rsMaster.fields(1).value
iNewPos = iStartPos
rsMaster.Close
if request.querystring("direction") = "down" then
iNewPos = iNewPos + 1
elseif request.querystring("direction") = "up" then
iNewPos = iNewPos - 1
end if
if iNewPos > 0 then
SQL = "select attachmentid, sortorder from attachments where messageid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & " and sortorder=" & iNewPos
rsMaster.Open SQL, dbConnection, adOpenStatic, adLockOptimistic
if not(rsMaster.EOF) then
rsMaster.fields(1).value = iStartPos
rsMaster.Update
dbConnection.execute "update attachments set sortorder=" & iNewPos & " where attachmentid=" & BBS.ValidateNumeric(iAttachmentID)
end if
rsMaster.Close
end if
end if
if request.querystring("action") = "postdelete" then
for each sAttachmentID in request.querystring("deleteattachmentid")
Forum.DeleteAttachment sAttachmentID, vMessageInfo(MI_MessageID)
next
end if
if request.querystring("action") = "postupload" then
' This starts the upload process
err.clear
on error resume next
Set Uploader = New FileUploader
Uploader.Upload()
if err.Number <> 0 then
dictEnvironment("V-RESPONSE") = dictLanguage("ATTACH-SERVERERROR")
bError = True
end if
on error goto 0
' Check if any files were uploaded
if not bError then
If Uploader.Files.Count = 0 Then
dictEnvironment("V-RESPONSE") = dictLanguage("ATTACH-NOFILES")
else
' Loop through the uploaded files
For Each File In Uploader.Files.Items
bError = False
if iMaxFileSize <> 0 and File.FileSize > iMaxFileSize then
dictEnvironment("V-RESPONSE") = dictLanguage("ATTACH-FILESIZE") & iMaxFileSize/1024 & dictLanguage("GLOBAL-KB") & "."
bError = True
end if
if (File.FileSize <= 2) then
dictEnvironment("V-RESPONSE") = dictLanguage("ATTACH-NOFILES")
bError = True
end if
if bError = False then
SQL = "select max(sortorder) as maxsort from attachments where messageid=" & iMessageID
rsMaster.OPEN SQL, dbConnection, adOpenForwardOnly, adLockReadOnly
if rsMaster.EOF then
iAttachmentOrder = 1
else
iAttachmentOrder = BBS.ValidateNumeric(rsMaster.fields(0).value) +1
end if
rsMaster.Close
' Kind of a cheap hack.
SQL = "select * from attachments where attachmentid=-1" & iAttachmentID
if ucase(sBBSDatabaseType) = "MYSQL" Then
rsMaster.open SQL, sConnString & "OPTION=16387;", adOpenStatic, adLockOptimistic
else
rsMaster.open SQL, dbConnection, adOpenStatic, adLockOptimistic
end if
rsMaster.AddNew
rsMaster.fields("messageid").value = iMessageID
rsMaster.fields("filesize").value = file.FileSize
rsMaster.fields("filename").value = File.FileName
rsMaster.fields("sortorder").value = iAttachmentOrder
rsMaster.fields("downloadcount").value = 0
if dictConfiguration("bSTOREINFILESYSTEM") = 1 then
sGUID = mid(trim(Server.CreateObject("Scriptlet.Typelib").GUID), 2, 36)
File.SaveToDiskMBBS(server.mappath(sBBSForumRoot & "/forums/attachments") & "\" & vMessageInfo(MI_MessageID) & "-" & sGUID)
rsMaster("file").value = GetBlankBinary
rsMaster("infilesystem").value = 1
rsMaster("fileguid").value = sGUID
else
File.SaveToDatabase rsMaster("file")
rsMaster("infilesystem").value = 0
rsMaster("fileguid").value = ""
end if
rsMaster.Update
' iAttachmentID = rsMaster("attachmentid")
rsMaster.Close
Forum.UpdateAttachments vMessageInfo(MI_MessageID)
dictEnvironment("V-RESPONSE") = dictLanguage("ATTACH-SUCCESS")
end if
next
end if
end if
end if
' Create the delete form
SQL = "select attachmentid, filename, filesize, downloadcount, sortorder from attachments where messageid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & " order by sortorder asc"
rsMaster.open SQL, dbConnection, adOpenForwardOnly, adLockReadOnly
BBS.AddQuery(SQL)
if not rsMaster.EOF then
vFiles = rsMaster.getrows
rsMaster.close
sDeleteForm = "<form ENCTYPE='multipart/form-data' method='get' action='attach-file.asp'>"
sDeleteForm = sDeleteForm & "<input type='hidden' name='action' value='postdelete'>"
sDeleteForm = sDeleteForm & "<input type='hidden' name='mid' value='" & vMessageInfo(MI_MEssageID) & "'>"
sDeleteForm = sDeleteForm & "<table align='center' class='bbstable' cellspacing='" & dictTemplate("CELLSPACING") & "' width='100%'>"
sDeleteForm = sDeleteForm & "<tr><td colspan='2' class='messagecellheader'>" & dictLanguage("ATTACH-DELETE") & "</td></tr>"
for index = 0 to ubound(vFiles, 2)
sDeleteForm = sDeleteForm & "<tr><td nowrap class='messagecellbody'>"
sDeleteForm= sDeleteForm & "<input type='checkbox' class='bbscheckbox' name='deleteattachmentid' value='" & vFiles(0, index) & "'> "
' Sortorder
if index > 0 then
sDeleteForm = sDeleteForm & "<a href='attach-file.asp?move=true&mid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & "&attachmentid=" & BBS.ValidateNumeric(vFiles(0, index)) & "&direction=up'><img alt='" & dictLanguage("GLOBAL-UP") & "' border='0' src='" & dictImages.item("SORT-BUTTON-UP") & "'></a> "
end if
if index < ubound(vFiles, 2) then
sDeleteForm = sDeleteForm & "<a href='attach-file.asp?move=true&mid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & "&attachmentid=" & BBS.ValidateNumeric(vFiles(0, index)) & "&direction=down'><img alt='" & dictLanguage("GLOBAL-DOWN") & "' border='0' src='"& dictImages.item("SORT-BUTTON-DOWN") & "'></a> </td>"
end if
sDeleteForm= sDeleteForm & "<td width='100%' class='messagecellbody'><a href='get-attachment.asp?attachmentid=" & vFiles(0, index) & "'>" & BBS.ValidateField(vFiles(1, index)) & "</a> - " & vFiles(2, index) \ 1024 & dictLanguage("GLOBAL-KB") & "</td></tr>"
next
sDeleteForm = sDeleteForm & "<tr><td colspan='2' class='messagecellfooter' align='center'><input type='submit' class='bbsbutton' value='" & dictLanguage("GLOBAL-DELETE") & "'></td></tr></table></form>"
sDeleteForm = sDeleteForm & "<a href='attach-file.asp?mid=" & BBS.ValidateNumeric(vMessageInfo(MI_MessageID)) & "&repair=true'>" & dictLanguage("ATTACH-REPAIR") & "</a>"
else
rsMaster.Close
end if
dictEnvironment("U-RETURN") = "thread-view.asp?tid=" & vThreadInfo(TI_ThreadID)
dictEnvironment("U-FORMACTION") = "attach-file.asp?action=postupload&mid=" & vMessageInfo(MI_MessageID)
dictEnvironment("V-DELETEFORM") = sDeleteForm
dictEnvironment("V-THREAD") = vThreadInfo
dictEnvironment("V-MESSAGE") = vMessageInfo
dictEnvironment("V-CATEGORY") = vCategoryInfo
dictEnvironment.add "V-TITLE", dictLanguage.item("ATTACH-TITLE")
dictEnvironment.add "C-SHOWRANDOMQUOTES", vForumInfo(FI_ShowQuotes)
if iBBSUserLevel >= USERLEVEL_SupportAdministrator then dictEnvironment.add "C-SHOWADMINLINK", 1
Function GetBlankBinary()
Dim pbinBinaryData
pBinBinaryData = chrb(46) & chrb(46)
Dim lobjRs
Dim llngLength
Dim lbinBuffer
CONST adLongVarBinary = 205
llngLength = LenB(pbinBinaryData)
Set lobjRs = Server.CreateObject("ADODB.Recordset")
Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
Call lobjRs.Open()
Call lobjRs.AddNew()
Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
Call lobjRs.Update()
lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
Call lobjRs.Close()
Set lobjRs = Nothing
GetBlankBinary = lbinBuffer
End Function
%>
<!-- #include file="../includes/header.asp" -->
<% Filesystem.ExecuteBBSTemplate("/forum/attach-file.asp") %>
<!-- #include file="../includes/footer.asp" -->
*************************************
*************************************
Og her kommer include-upload.asp
*************************************
*************************************
<%
'***************************************
' File: Upload.asp
' Author: Jacob "Beezle" Gilley
' Email: avis7@airmail.net
' Date: 12/07/2000
' Comments: The code for the Upload, CByteString,
' CWideString subroutines was originally
' written by Philippe Collignon...or so
' he claims. Also, I am not responsible
' for any ill effects this script may
' cause and provide this script "AS IS".
' Enjoy!
'
'
' Some code copied from another upload
' component by Lewis Moten - Matt (pd9)
'
'
'****************************************
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
if (lenb(MidB(biData, nPosBegin, nPosEnd-nPosBegin)) mod 2) = 1 then
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin) & chrb(0)
else
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
end if
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
' If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), (Mid(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
'response.binarywrite FileData
'oFile.Write FileData
Next
oFile.Close
End Sub
Public Sub SaveToDiskMBBSold(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Then Exit Sub
' NO NO NO
do until instr(sPath, "..") = 0
sPath = replace(sPath, "..", "")
loop
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
' If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath, True)
response.write sPath : response.flush
For nIndex = 1 to LenB(FileData)
response.write nIndex & "-<br/>" & CRLF
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
sub SaveToDiskMBBS(FileName)
Dim lobjStream
Dim lobjRs
Dim lbinBytes
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
' Don't save files that do not posess binary data
If LenB(FileData) = 0 Then Exit Sub
' Create magical objects from never never land
Set lobjStream = Server.CreateObject("ADODB.Stream")
' Let stream know we are working with binary data
lobjStream.Type = adTypeBinary
' Open stream
Call lobjStream.Open()
' Convert Integer Subtype Array to Byte Subtype Array
lbinBytes = ASCII2Bytes(FileData)
' Write binary data to stream
Call lobjStream.Write(lbinBytes)
' Save the binary data to file system
' Overwrites file if previously exists!
Call lobjStream.SaveToFile(FileName, adSaveCreateOverWrite)
' Close the stream object
Call lobjStream.Close()
' Release objects
Set lobjStream = Nothing
end sub
Private Function ASCII2Bytes(ByRef pbinBinaryData)
Dim lobjRs
Dim llngLength
Dim lbinBuffer
CONST adLongVarBinary = 205
' get number of bytes
llngLength = LenB(pbinBinaryData)
Set lobjRs = Server.CreateObject("ADODB.Recordset")
' create field in an empty recordset to hold binary data
Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
' Open recordset
Call lobjRs.Open()
' Add a new record to recordset
Call lobjRs.AddNew()
' Populate field with binary data
Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0))
' Update / Convert Binary Data
' Although the data we have is binary - it has still been
' formatted as 4 bytes to represent each byte. When we
' update the recordset, the Integer Subtype Array that we
' passed into the Recordset will be converted into a
' Byte Subtype Array
Call lobjRs.Update()
' Request binary data and save to stream
lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
' Close recordset
Call lobjRs.Close()
' Release recordset from memory
Set lobjRs = Nothing
' Return Bytes
ASCII2Bytes = lbinBuffer
End Function
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData & chrb(0)
End If
End Sub
End Class
%>
Må bare indrømme at det er for mange år siden at jeg sad og hobby programerede lidt i asp, til at jeg kan fatte denne kode ;-)
