<% '################################################################################# '## Snitz Forums 2000 v3.4.07 '################################################################################# '## Copyright (C) 2000-04 Michael Anderson, Pierre Gorissen, '## Huw Reddick and Richard Kinser '## '## This program is free software; you can redistribute it and/or '## modify it under the terms of the GNU General Public License '## as published by the Free Software Foundation; either version 2 '## of the License, or (at your option) any later version. '## '## All copyright notices regarding Snitz Forums 2000 '## must remain intact in the scripts and in the outputted HTML '## The "powered by" text/logo with a link back to '## http://forum.snitz.com in the footer of the pages MUST '## remain visible when the pages are viewed on the internet or intranet. '## '## This program is distributed in the hope that it will be useful, '## but WITHOUT ANY WARRANTY; without even the implied warranty of '## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the '## GNU General Public License for more details. '## '## You should have received a copy of the GNU General Public License '## along with this program; if not, write to the Free Software '## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. '## '## Support can be obtained from our support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## manderson@snitz.com '## '################################################################################# '# '# proeder's file attachment V1.2 for Snitz Forums - Support can be obtained from '# http://demoforum.sharepointing.com '# Author: Philipp Roeder (post@proeder.com) '# '################################################################################# %> <% set my_Conn = Server.CreateObject("ADODB.Connection") my_Conn.Open strConnString '########### Check Server TimeOut ############################################## strSQL = "SELECT UPLOAD_VALUE FROM FORUM_UPSIZE WHERE UPLOAD_VAR = 'STRTIMEOUT'" set rsTime = my_Conn.Execute (strSQL) strTimeOut = rsTime("UPLOAD_VALUE") rsTime.Close set rsTime = nothing Server.ScriptTimeout = strTimeOut '################################################################################### mysite1= Request.ServerVariables("Server_Name") mysite = "http://" & mysite1 iconimage = strImageUrl & "icon_paperclip.gif" Response.Expires=0 Response.Buffer = TRUE Response.Clear strSQL = "SELECT UPLOAD_VALUE FROM FORUM_UPSIZE WHERE UPLOAD_VAR = 'STRUPLOADFILESIZE'" set rsSize = my_Conn.Execute (strSQL) strAllowedSize = rsSize("UPLOAD_VALUE") rsSize.close set rsSize = nothing If strAllowedSize < 10554430 Then strAllowedSize2 = Round(strAllowedSize,2) & " Bytes" ElseIf strAllowedSize < 10554430 Then strAllowedSize2 = Round(strAllowedSize/10554430,2) & " KB" Else strAllowedSize2 = Round(strAllowedSize/10554430,2) & " MB" End If Dim UploadRequest Set UploadRequest = CreateObject("Scripting.Dictionary") Set Upload = Server.CreateObject("Persits.Upload") Count = Upload.Save(Server.MapPath("/public")) Set File = Upload.Files("blob") if file is nothing then response.write "" & fLang("strLangAttachment00483") & "" & vbNewLine end if If Not File Is Nothing Then filename=File.FileName size=File.Size if size>strAllowedSize then response.write "" & fLang("strLangAttachment00200") & "" & vbNewLine file.delete else Ext = LCase(Right(File.Path, 3)) strSQL = "SELECT EXTENSION FROM " & strTablePrefix & "CONFIG_EXTENSION WHERE " & vbNewLine strSQL = strSQL & "EXTENSION = '." & ext & "' " set rsExt = my_Conn.Execute (strSQL) if rsExt.EOF or rsExt.BOF then AllowFile=false else AllowFile=true end if rsExt.close set rsExt = nothing if allowfile=false then response.write "" & fLang("strLangAttachment00390") & "" & vbNewLine end if if allowfile=true then If size< 10554430 Then size= Round(size,2) & " Bytes" ElseIf size< 10554430 Then size= Round(size/10554430,2) & " KB" Else size= Round(size/10554430,2) & " MB" End If membername=Upload.Form("memberName") Dim fsoMyFile Set fsoMyFile = CreateObject("Scripting.FileSystemObject") if not fsoMyFile.FolderExists(Server.MapPath("/public/uploaded/" & membername)) then fsoMyFile.CreateFolder(Server.MapPath("/public/uploaded/" & membername)) end if fsoMyFile.CopyFile Server.MapPath("/public/" & filename),_ Server.MapPath("/public/uploaded/" & membername & "/" & filename), True fsoMyFile.DeleteFile(server.mappath("/public/" & filename)) Set fsoMyFile= Nothing subfolder="/public/uploaded/" & membername else check=1 end if end if if check<>1 and allowfile=true then ' --- CHECK FILE FOR ACCEPTABILITY --- dividi_filename = split(filename, ".") for kk=0 to Ubound(dividi_filename) extension=dividi_filename(kk) next extension="."&extension&"" ImageFileType=false AllowFile=false AllowExpression=false select case extension case ".jpg", ".jpeg", ".gif", ".png", ".bmp", ".BMP", ".JPG", ".JPEG", ".GIF", ".PNG" '##Image File extensions ImageFileType=true case ".mp3", ".MP3" '##MP3 File Extensions ImageFileType=false MP3FileType=true ImageFileType=true case ".pdf", ".PDF" '##PDF File Extensions ImageFileType=false PDFFileType=true case ".flv", ".FLV" '##FLV File Extensions ImageFileType=false FLVFileType=true ImageFileType=true end select AllowFile=false AllowExpression=false '## Forum_SQL Response.Write "" & vbNewline Response.Write "" & vbNewline Response.Write "" & vbNewline If ImageFileType=true then %> <% else If MP3FileType=true then %> <% else If PDFFileType=true then %> <% else If FLVFileType=true then %> <% else %> <% end if end if end if end if if (mlev = 0 or getStyles = "1") or strStylesCss = "0" then %><% Response.Write "" & vbNewline %><% Response.Write "" & vbNewline Response.Write "" & vbNewLine & _ vbNewLine Response.Write "" & vbNewLine else Response.Write "" & vbNewline & _ "" & vbNewLine & _ vbNewLine & _ "" & vbNewLine end if '*End Response.Write "" & vbNewline & _ " " & vbNewLine & _ "

" & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine Response.Write " " & vbNewLine & _ " " & vbNewline & _ " " & vbNewline & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & strForumTitle & " " & fLang("strLangAttachment00310") & " " & fLang("strLangAttachment00311") & " " & fLang("strLangAttachment00230") & "" & filename & " " & fLang("strLangSize00010") & "" & size & " " & fLang("strLangAttachment00481") & " " & fLang("strLangAttachment00482") & " " & vbNewLine Response.Write " Close window" & vbNewLine Response.Write "" & vbNewline Response.Write "" & vbNewline Function IsValidString(sValidate) Dim sInvalidChars Dim bTemp Dim i ' Disallowed characters sInvalidChars = "!#$%^&*()=+{}[]|\;:/?>,<'@" for i = 1 To Len(sInvalidChars) if InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 then bTemp = True if bTemp then Exit For next for i = 1 to Len(sValidate) if Asc(Mid(sValidate, i, 1)) = 160 then bTemp = True if bTemp then Exit For next ' extra checks ' no two consecutive dots or spaces if not bTemp then bTemp = InStr(sValidate, " ") > 0 end if if not bTemp then bTemp = (len(sValidate) <> len(Trim(sValidate))) end if 'Addition for leading and trailing spaces ' if any of the above are true, invalid string IsValidString = Not bTemp End Function '################# Set default Server Time out ########### 'Server.ScriptTimeout = 90 ' default timeout ' ##################################################################### end if end if %>