www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\users\Upload.asp
<!--#include file="inc/const.asp"--> <!--#include file="inc/check.asp"--> <!--#include file="../inc/cls_upload.asp"--> <script language=JavaScript> // 文件上传成功接口操作 function doInterfaceUpload(strValue){ if (strValue=="") return; var objLinkUpload = parent.document.getElementsByName("UploadFileList")[0]; if (objLinkUpload){ if (objLinkUpload.value!=""){ objLinkUpload.value = objLinkUpload.value + "|"; } objLinkUpload.value = objLinkUpload.value + strValue; objLinkUpload.fireEvent("onchange"); } } </script> <% Server.ScriptTimeOut = 18000 Dim UploadObject,AllowFileSize,AllowFileExt Dim sUploadDir,SaveFileName,PathFileName,url Dim sAction,sType,SaveFilePath,UploadPath Dim m_strFileExt,m_strRootPath,m_strInstance UploadObject = CInt(NewAsp.UploadSetting(0)) '上传文件对象 --- 0=无组件上传,1=Aspupload3.0组件,2=SA-FileUp 4.0组件 AllowFileSize = CLng(NewAsp.MaxFileSize * 1024 ) AllowFileExt = NewAsp.UpFileType AllowFileExt = Replace(Replace(Replace(UCase(AllowFileExt), "ASP", ""), "ASPX", ""), "|", ",") url = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST") sType = UCase(Request.QueryString("sType")) If NewAsp.CheckPost=False Then Call ToErrors(Postmsg) Response.End End If Dim ChannelSetting,m_strUploadPicDir If Len(NewAsp.Channel_Setting &"") < 30 Then NewAsp.Channel_Setting = "0|||1|||2|||3|||4|||0|||1|||UploadPic/|||UploadFile/|||" ChannelSetting = Split(NewAsp.Channel_Setting & "|||||||||||||||", "|||") m_strUploadPicDir = Replace(Trim(ChannelSetting(7)), "\", "/") If Len(m_strUploadPicDir) < 2 Then m_strUploadPicDir = "UploadPic/" If Right(m_strUploadPicDir,1) <> "/" Then m_strUploadPicDir = m_strUploadPicDir & "/" m_strInstance = "content" m_strRootPath = NewAsp.InstallDir Select Case ChannelID Case 0 If stype = "AD" Then UploadPath = "adfile/UploadPic/" sUploadDir = NewAsp.InstallDir & UploadPath ElseIf stype = "LINK" Then UploadPath = "link/UploadPic/" sUploadDir = NewAsp.InstallDir & UploadPath Else UploadPath = "UploadFile/" sUploadDir = NewAsp.InstallDir & UploadPath End If Case Else UploadPath = m_strUploadPicDir sUploadDir = NewAsp.InstallDir & NewAsp.ChannelDir & UploadPath m_strRootPath = NewAsp.InstallDir & NewAsp.ChannelDir End Select sAction = UCase(Trim(Request.QueryString("action"))) If sAction = "SAVE" Then If CInt(NewAsp.StopUpload) = 1 Then Response.Write ("<script>alert('对不起!本频道未开放上传功能!');history.go(-1)</script>") Response.End End If If CInt(GroupSetting(20)) <> 1 Then Response.Write ("<script>alert('对不起!您没有上传文件的权限');history.go(-1)</script>") Response.End End If If CLng(UserToday(1)) => CLng(GroupSetting(21)) Then Response.Write ("<script>alert('对不起!您每天只能上传" & GroupSetting(21) & "个文件。');history.go(-1)</script>") Response.End End If Select Case UploadObject Case 0,1,2,3 Call UploadFile Case 999 Response.Write ("<script>alert('本系统未开放上传功能!');history.go(-1)</script>") Response.End Case Else Response.Write ("<script>alert('本系统未开放上传功能!');history.go(-1)</script>") Response.End End Select Dim strUserToday strUserToday = UserToday(0) &","& UserToday(1)+1 &","& UserToday(2) &","& UserToday(3) &","& UserToday(4) &","& UserToday(5) UpdateUserToday(strUserToday) SaveFilePath = UploadPath & SaveFilePath Call OutScript(SaveFilePath) Else Call UploadMain End If Sub UploadFile() Dim Upload,FilePath,sFilePath,FormName,File,F_FileName Dim DrawInfo,Previewpath,strPreviewPath Dim PreviewName,F_Viewname,MakePreview '-- 是否生成缩略图片 MakePreview = False Previewpath = NewAsp.InstallDir & NewAsp.ChannelDir strPreviewPath = m_strUploadPicDir & CreatePath(Previewpath & m_strUploadPicDir) PreviewPath = Previewpath & strPreviewpath If CInt(NewAsp.UploadSetting(6)) = 1 Then DrawInfo = NewAsp.UploadSetting(9) ElseIf CInt(NewAsp.UploadSetting(6)) = 2 Then DrawInfo = NewAsp.InstallDir & NewAsp.UploadSetting(14) If Not NewAsp.FilePathExists(DrawInfo,1) Then NewAsp.UploadSetting(6) = 1 DrawInfo = NewAsp.UploadSetting(9) End If Else DrawInfo = "" End If If DrawInfo = "0" Then DrawInfo = "" NewAsp.UploadSetting(6) = 0 End If sFilePath = CreatePath(sUploadDir) '按日期生成目录 FilePath = sUploadDir & sFilePath Set Upload = New UpFile_Cls Upload.UploadType = UploadObject '设置上传组件类型 Upload.UploadPath = FilePath '设置上传路径 Upload.MaxSize = AllowFileSize '单位 KB Upload.InceptMaxFile = 10 '每次上传文件个数上限 Upload.InceptFileType = AllowFileExt '设置上传文件限制 Upload.ChkSessionName = "uploadPic" '预览图片设置 Upload.MakePreview = MakePreview Upload.PreviewType = CInt(NewAsp.UploadSetting(4)) '设置预览图片组件类型 Upload.PreviewImageWidth = CInt(NewAsp.UploadSetting(7)) '设置预览图片宽度 Upload.PreviewImageHeight = CInt(NewAsp.UploadSetting(8)) '设置预览图片高度 Upload.DrawImageWidth = CInt(NewAsp.UploadSetting(17)) '设置水印图片或文字区域宽度 Upload.DrawImageHeight = CInt(NewAsp.UploadSetting(18)) '设置水印图片或文字区域高度 Upload.DrawGraph = CCur(NewAsp.UploadSetting(15)) '设置水印透明度 Upload.DrawFontColor = NewAsp.UploadSetting(11) '设置水印文字颜色 Upload.DrawFontFamily = NewAsp.UploadSetting(12) '设置水印文字字体格式 Upload.DrawFontSize = CInt(NewAsp.UploadSetting(10)) '设置水印文字字体大小 Upload.DrawFontBold = CInt(NewAsp.UploadSetting(13)) '设置水印文字是否粗体 Upload.DrawInfo = DrawInfo '设置水印文字信息或图片信息 Upload.DrawType = CInt(NewAsp.UploadSetting(6)) '0=不加载水印 ,1=加载水印文字,2=加载水印图片 Upload.DrawXYType = CInt(NewAsp.UploadSetting(19)) '"0" =左上,"1"=左下,"2"=居中,"3"=右上,"4"=右下 Upload.DrawSizeType = CInt(NewAsp.UploadSetting(5)) '"0"=固定缩小,"1"=等比例缩小 If NewAsp.UploadSetting(16)<>"" Or NewAsp.UploadSetting(16)<>"0" Then Upload.TransitionColor = NewAsp.UploadSetting(16) '透明度颜色设置 End If '执行上传 Upload.SaveUpFile If Upload.ErrCodes<>0 Then Response.write ("<script>alert('错误:"& Upload.Description & "');history.go(-1)</script>") Exit Sub End If If Upload.Count > 0 Then For Each FormName In Upload.UploadFiles Set File = Upload.UploadFiles(FormName) SaveFilePath = sFilePath & File.FileName F_FileName = FilePath & File.FileName m_strFileExt = File.FileExt '创建预览及水印图片 If Upload.PreviewType<>999 and File.FileType=1 then PreviewName = "p" & Replace(File.FileName,File.FileExt,"") & "jpg" F_Viewname = Previewpath & PreviewName '创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀) Upload.CreateView F_FileName,F_Viewname,File.FileExt If CBool(MakePreview) Then Call OutPreview(strPreviewPath & PreviewName) End If End If Set File = Nothing Next Else Call OutAlertScript("请选择一个有效的上传文件。!!!") Exit Sub End If Set Upload = Nothing End Sub Sub UploadMain() Dim PostRanNum Randomize PostRanNum = Int(900*rnd)+1000 Session("uploadPic") = Cstr(PostRanNum) %> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <title>文件上传</title> <style type="text/css"> td,div,input,select,textarea,body {font-family:Verdana, 宋体, fantasy;font-size:12px;color:#2F969B;} body {margin:0;padding:0;background-color:transparent;} form {margin:0;padding:0;} </style> </head> <body> <table style="width:100%;height:100%" border="0" cellspacing="0" cellpadding="0" align=center> <tr vAlign="top"> <td class="TableRow1"> <table border="0" cellspacing="0" cellpadding="0"> <form action='?action=save&ChannelID=<%=ChannelID%>&sType=<%=sType%>' method="post" name="form2" enctype="multipart/form-data"> <tr vAlign="top"> <td align="center" noWrap valign="top"> <INPUT TYPE="hidden" name="uploadPic" value="<%=PostRanNum%>"> <input type="file" name="file1" size="50"> <input type="submit" name="Submit" value="开始上传"> </td> </tr><tr vAlign="top"><TD colspan="4" class="TableRow1" valign="top"> 允许上传的文件类型:<%=AllowFileExt%> <br> 允许上传的大小:<font color=red><B><%=CStr(NewAsp.MaxFileSize)%></B></font> KB 您今天还可以上传<font color=red><B><%=CLng(GroupSetting(21)) - CLng(UserToday(1)) %></B></font>个文件</td> </tr></form></table></td> </tr></table> </body> </html> <% End Sub Private Sub OutScript(url) Response.Write "<script language=javascript>" & vbCrLf Response.Write "parent.document.myform.ImageUrl.value='" & url & "';" & vbCrLf If CInt(NewAsp.Modules) = 1 Then Response.Write "doInterfaceUpload('" & url & "')" & vbCrLf OutUploadScript(url) End If Response.Write "alert('文件上传成功!\n"&url&"');" & vbCrLf 'Response.Write "history.go(-1);" & vbCrLf Response.Write "location.replace('" & Request.ServerVariables("HTTP_REFERER") & "')" & vbCrLf Response.Write "</script>" & vbCrLf End Sub Sub OutPreview(url) Response.Write "<script language=javascript>" & vbCrLf Response.Write "parent.document.myform.ImageUrl1.value='" & url & "';" & vbCrLf Response.Write "</script>" & vbCrLf End Sub Sub OutUploadScript(strPath) sType = LCase(m_strFileExt) strPath = m_strRootPath & strPath Response.Write "var EditType="""";" & vbCrLf Response.Write "try{" & vbCrLf Response.Write " var oEditor = parent.FCKeditorAPI.GetInstance('" & m_strInstance & "')" & vbCrLf Response.Write " EditType=""FCkEditor"";" & vbCrLf Response.Write "}" & vbCrLf Response.Write "catch(e){" & vbCrLf Response.Write " EditType=""UBBEditor"";" & vbCrLf Response.Write "}" & vbCrLf Response.Write "if (EditType==""UBBEditor""){parent.document.forms[0]." & m_strInstance & ".value+=" Select Case sType Case "gif","jpg","png","bmp","jpeg","tif","iff" Response.Write "'[img]" & strPath & "[/img]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<img src=""" & strPath & """ alt="""" />')}" & vbCrLf Case "swf" Response.Write "'[flash]" & strPath & "[/flash]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<object codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0"" classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" width=""400"" height=""300""><param name=""movie"" value=""" & strPath & """ /><param name=""quality"" value=""high"" /><param name=""AllowScriptAccess"" value=""never"" /><embed src=""" & strPath & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""400"" height=""300"" /></object>')}" & vbCrLf Case "mp3","wma" Response.Write "'[wma]" & strPath & "[/wma]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<object classid=""CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95"" id=""MediaPlayer"" width=""450"" height=""70""><param name=""howStatusBar"" value=""-1""><param name=""AutoStart"" value=""False""><param name=""Filename"" value=""" & strPath & """></object>')}" & vbCrLf Case "rm","rmvb" Response.Write "'[rm]" & strPath & "[/rm]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""300""><param name=""SRC"" value=""" & strPath & """ /><param name=""CONTROLS"" VALUE=""ImageWindow"" />" Response.Write "<param name=""CONSOLE"" value=""one"" /><param name=""AUTOSTART"" value=""true"" /><embed src=""" & strPath & """ nojava=""true"" controls=""ImageWindow"" console=""one"" width=""400"" height=""300""></object><br/>" Response.Write "<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" /><param name=""CONTROLS"" value=""StatusBar"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" />" Response.Write "<embed src=""" & strPath & """ nojava=""true"" controls=""StatusBar"" console=""one"" width=""400"" height=""24"" /></object><br/><object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" />" Response.Write "<param name=""CONTROLS"" value=""ControlPanel"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" /><embed src=""" & strPath & """ nojava=""true"" controls=""ControlPanel"" console=""one"" width=""400"" height=""24"" autostart=""true"" loop=""false"" /></object>')}" & vbCrLf Case "ra" Response.Write "'[ra]" & strPath & "[/ra]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" id=""RAOCX"" width=""450"" height=""60""><param name=""_ExtentX"" value=""6694""><param name=""_ExtentY"" value=""1588""><param name=""AUTOSTART"" value=""true""><param name=""SHUFFLE"" value=""0""><param name=""PREFETCH"" value=""0"">" Response.Write "<param name=""NOLABELS"" value=""0""><param name=""SRC"" value=""" & strPath & """><param name=""CONTROLS"" value=""StatusBar,ControlPanel""><param name=""LOOP"" value=""0""><param name=""NUMLOOP"" value=""0""><param name=""CENTER"" value=""0""><param name=""MAINTAINASPECT"" value=""0""><param name=""BACKGROUNDCOLOR"" value=""#000000""><embed src=""" & strPath & """ width=""450"" autostart=""true"" height=""60""></embed></object>')}" & vbCrLf Case "asf","avi","wmv" Response.Write "'[wmv]" & strPath & "[/wmv]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" codebase=""http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,0,02,902"" type=""application/x-oleobject"" standby=""Loading..."" width=""400"" height=""300"">" Response.Write "<param name=""FileName"" VALUE=""" & strPath & """ /><param name=""ShowStatusBar"" value=""-1"" /><param name=""AutoStart"" value=""true"" /><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""" & strPath & """ autostart=""true"" width=""400"" height=""300"" /></object>')}" & vbCrLf Case Else Response.Write "'[down=" & strPath & "]点击下载此文件[/down]\n'}" & vbCrLf Response.Write "else{oEditor.InsertHtml('<a href=""" & strPath & """><img src=""" & NewAsp.InstallDir & "images/pic/download.gif"" border=""0"" style=""margin:0px 2px -4px 0px""/>点击下载此文件</a>')}" & vbCrLf End Select End Sub %>