BVB Source Codes

Jie Yang v0.6.3 article system Show Upload.asp Source code

Return Download Jie Yang v0.6.3 article system: download Upload.asp Source code - Download Jie Yang v0.6.3 article system Source code - Type:.asp
  1. <!--#include file="Include/Startup.asp"-->
  2. <!--#include file="Include/upfile_class.asp"-->
  3. <%
  4. Server.ScriptTimeOut = 1800
  5. ' 参数变量
  6. Dim sType, sStyleName
  7. ' 设置变量
  8. Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
  9. ' 接口变量
  10. Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
  11.  
  12.  
  13. Call DBConnBegin()              ' 初始化数据库连接
  14. Call InitUpload()               ' 初始化上传变量
  15. Call DBConnEnd()                ' 断开数据库连接
  16.  
  17.  
  18. Dim sAction
  19. sAction = UCase(Trim(Request.QueryString("action")))
  20.  
  21. Select Case sAction
  22. Case "REMOTE"
  23.         Call DoRemote()                 ' 远程自动获取
  24. Case "SAVE"
  25.         Call ShowForm()                 ' 显示上传表单
  26.         Call DoSave()                   ' 存文件
  27. Case Else
  28.         Call ShowForm()                 ' 显示上传表单
  29. End Select
  30.  
  31.  
  32.  
  33. Sub ShowForm()
  34. %>
  35. <HTML>
  36. <HEAD>
  37. <TITLE>文件上传</TITLE>
  38. <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
  39. <style type="text/css">
  40. body, a, table, div, span, td, th, input, select{font:9pt;font-family: "宋体", Verdana, Arial, Helvetica, sans-serif;}
  41. body {padding:0px;margin:0px}
  42. </style>
  43.  
  44. <script language="JavaScript" src="dialog/dialog.js"></script></head>
  45. <body bgcolor=menu>
  46. <form action="?action=save&type=<%=sType%>&style=<%=sStyleName%>&sUploadDir=<%=sUploadDir%>" method=post name=myform enctype="multipart/form-data">
  47. <input type=file name=uploadfile size=1 style="width:100%" onChange="originalfile.value=this.value">
  48. <input type=hidden name=originalfile value="">
  49. </form>
  50.  
  51. <script language=javascript>
  52.  
  53. var sAllowExt = "<%=sAllowExt%>";
  54. // 检测上传表单
  55. function CheckUploadForm() {
  56.         if (!IsExt(document.myform.uploadfile.value,sAllowExt)){
  57.                 parent.UploadError("提示:\n\n请选择一个有效的文件,\n支持的格式有("+sAllowExt+")!");
  58.                 return false;
  59.         }
  60.         return true
  61. }
  62.  
  63. // 提交事件加入检测表单
  64. var oForm = document.myform ;
  65. oForm.attachEvent("onsubmit", CheckUploadForm) ;
  66. if (! oForm.submitUpload) oForm.submitUpload = new Array() ;
  67. oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;
  68. if (! oForm.originalSubmit) {
  69.         oForm.originalSubmit = oForm.submit ;
  70.         oForm.submit = function() {
  71.                 if (this.submitUpload) {
  72.                         for (var i = 0 ; i < this.submitUpload.length ; i++) {
  73.                                 this.submitUpload[i]() ;
  74.                         }
  75.                 }
  76.                 this.originalSubmit() ;
  77.         }
  78. }
  79.  
  80. // 上传表单已装入完成
  81. try {
  82.         parent.UploadLoaded();
  83. }
  84. catch(e){
  85. }
  86.  
  87. </script></body>
  88. </html>
  89. <%
  90. End Sub
  91.  
  92.  
  93. ' 保存操作
  94. Sub DoSave()
  95.  
  96.         ' 默认无组件上传类
  97.         Call DoUpload_Class
  98.        
  99.         sPathFileName = sContentPath & sSaveFileName
  100.         Call OutScript("parent.UploadSaved('" & sPathFileName & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){}")
  101.  
  102. End Sub
  103.  
  104. ' 自动获取远程文件
  105. Sub DoRemote()
  106.         Dim sContent, i
  107.         For i = 1 To Request.Form("eWebEditor_UploadText").Count
  108.                 sContent = sContent & Request.Form("eWebEditor_UploadText")(i)
  109.         Next
  110.         If sAllowExt <> "" Then
  111.                 sContent = ReplaceRemoteUrl(sContent, sAllowExt)
  112.         End If
  113.  
  114.         Response.Write "<HTML><HEAD><TITLE>远程上传</TITLE><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>" & _
  115.                 "<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
  116.                 "</body></html>"
  117.  
  118.         Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")
  119.  
  120. End Sub
  121.  
  122. ' 无组上传类
  123. Sub DoUpload_Class()
  124.         On Error Resume Next
  125.         Dim oUpload, oFile
  126.         ' 建立上传对象
  127.         Set oUpload = New upfile_class
  128.         ' 取得上传数据,限制最大上传
  129.         oUpload.GetData(nAllowSize*1024)
  130.  
  131.         If oUpload.Err > 0 Then
  132.                 Select Case oUpload.Err
  133.                 Case 1
  134.                         Call OutScript("parent.UploadError('请选择有效的上传文件!')")
  135.                 Case 2
  136.                         Call OutScript("parent.UploadError('你上传的文件总大小超出了最大限制(" & nAllowSize & "KB)!')")
  137.                 End Select
  138.                 Response.End
  139.         End If
  140.  
  141.         Set oFile = oUpload.File("uploadfile")
  142.         sFileExt = LCase(oFile.FileExt)
  143.         Call CheckValidExt(sFileExt)
  144.         sOriginalFileName = oFile.FileName
  145.         sSaveFileName = GetRndFileName(sFileExt)
  146.         oFile.SaveToFile Server.Mappath(sUploadDir & sSaveFileName)
  147.        
  148.         Set oFile = Nothing
  149.         Set oUpload = Nothing
  150. End Sub
  151.  
  152. ' 取随机文件名
  153. Function GetRndFileName(sExt)
  154.         Dim sRnd
  155.         Randomize
  156.         sRnd = Int(900 * Rnd) + 100
  157.         GetRndFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & sRnd & "." & sExt
  158. End Function
  159.  
  160. ' 输出客户端脚本
  161. Sub OutScript(str)
  162.         Response.Write "<script language=javascript>" & str & ";history.back()</script>"
  163. End Sub
  164. Sub OutScriptNoBack(str)
  165.         Response.Write "<script language=javascript>" & str & "</script>"
  166. End Sub
  167.  
  168.  
  169. ' 检测扩展名的有效性
  170. Sub CheckValidExt(sExt)
  171.         Dim b, i, aExt
  172.         b = False
  173.         aExt = Split(sAllowExt, "|")
  174.         For i = 0 To UBound(aExt)
  175.                 If LCase(aExt(i)) = sExt Then
  176.                         b = True
  177.                         Exit For
  178.                 End If
  179.         Next
  180.         If b = False Then
  181.                 OutScript("parent.UploadError('提示:\n\n请选择一个有效的文件,\n支持的格式有("+sAllowExt+")!')")
  182.                 Response.End
  183.         End If
  184. End Sub
  185.  
  186.  
  187. ' 初始化上传限制数据
  188. Sub InitUpload()
  189.         sType = UCase(Trim(Request.QueryString("type")))
  190.         sStyleName = Get_SafeStr(Trim(Request.QueryString("style")))
  191.         sSql = "select * from ewebeditor_style where s_name='" & sStyleName & "'"
  192.         oRs.Open sSql, oConn, 0, 1
  193.         If Not oRs.Eof Then
  194.                 sBaseUrl = oRs("S_BaseUrl")
  195.                 nUploadObject = oRs("S_UploadObject")
  196.                 nAutoDir = oRs("S_AutoDir")
  197.                 'sUploadDir = oRs("S_UploadDir")
  198.                 sUploadDir=Session("sUploadDir")
  199.                 Select Case sBaseUrl
  200.                 Case "0"
  201.                         sContentPath = oRs("S_ContentPath")
  202.                 Case "1"
  203.                         sContentPath = RelativePath2RootPath(sUploadDir)
  204.                         'sContentPath=sUploadDir
  205. '                       response.Write sContentPath
  206. '                       response.End()
  207.                 Case "2"
  208.                         sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
  209.                 End Select
  210.  
  211.                 Select Case sType
  212.                 Case "REMOTE"
  213.                         sAllowExt = oRs("S_RemoteExt")
  214.                         nAllowSize = oRs("S_RemoteSize")
  215.                 Case "FILE"
  216.                         sAllowExt = oRs("S_FileExt")
  217.                         nAllowSize = oRs("S_FileSize")
  218.                 Case "MEDIA"
  219.                         sAllowExt = oRs("S_MediaExt")
  220.                         nAllowSize = oRs("S_MediaSize")
  221.                 Case "FLASH"
  222.                         sAllowExt = oRs("S_FlashExt")
  223.                         nAllowSize = oRs("S_FlashSize")
  224.                 Case Else
  225.                         sAllowExt = oRs("S_ImageExt")
  226.                         nAllowSize = oRs("S_ImageSize")
  227.                 End Select
  228.         Else
  229.                 OutScript("parent.UploadError('无效的样式ID号,请通过页面上的链接进行操作!')")
  230.         End If
  231.         oRs.Close
  232.         ' 任何情况下都不允许上传asp脚本文件
  233.         sAllowExt = Replace(UCase(sAllowExt), "ASP", "")
  234. End Sub
  235.  
  236. ' 转为根路径格式
  237. Function RelativePath2RootPath(url)
  238.         Dim sTempUrl
  239.         sTempUrl = url
  240.         If Left(sTempUrl, 1) = "/" Then
  241.                 RelativePath2RootPath = sTempUrl
  242.                 Exit Function
  243.         End If
  244.  
  245.         Dim sWebEditorPath
  246.         sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
  247.         sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
  248.         Do While Left(sTempUrl, 3) = "../"
  249.                 sTempUrl = Mid(sTempUrl, 4)
  250.                 sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
  251.         Loop
  252.         RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
  253. End Function
  254.  
  255. ' 根路径转为带域名全路径格式
  256. Function RootPath2DomainPath(url)
  257.         Dim sHost, sPort
  258.         sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
  259.         sPort = Request.ServerVariables("SERVER_PORT")
  260.         If sPort <> "80" Then
  261.                 sHost = sHost & ":" & sPort
  262.         End If
  263.         RootPath2DomainPath = sHost & url
  264. End Function
  265.  
  266. '================================================
  267. '作  用:替换字符串中的远程文件为本地文件并保存远程文件
  268. '参  数:
  269. '       sHTML           : 要替换的字符串
  270. '       sExt            : 执行替换的扩展名
  271. '================================================
  272. Function ReplaceRemoteUrl(sHTML, sExt)
  273.         Dim s_Content
  274.         s_Content = sHTML
  275.         If IsObjInstalled("Microsoft.XMLHTTP") = False then
  276.                 ReplaceRemoteUrl = s_Content
  277.                 Exit Function
  278.         End If
  279.        
  280.         Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
  281.         Set re = new RegExp
  282.         re.IgnoreCase  = True
  283.         re.Global = True
  284.         re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))"
  285.  
  286.         Set RemoteFile = re.Execute(s_Content)
  287.         Dim a_RemoteUrl(), n, i, bRepeat
  288.         n = 0
  289.         ' 转入无重复数据
  290.         For Each RemoteFileurl in RemoteFile
  291.                 If n = 0 Then
  292.                         n = n + 1
  293.                         Redim a_RemoteUrl(n)
  294.                         a_RemoteUrl(n) = RemoteFileurl
  295.                 Else
  296.                         bRepeat = False
  297.                         For i = 1 To UBound(a_RemoteUrl)
  298.                                 If UCase(RemoteFileurl) = UCase(a_RemoteUrl(i)) Then
  299.                                         bRepeat = True
  300.                                         Exit For
  301.                                 End If
  302.                         Next
  303.                         If bRepeat = False Then
  304.                                 n = n + 1
  305.                                 Redim Preserve a_RemoteUrl(n)
  306.                                 a_RemoteUrl(n) = RemoteFileurl
  307.                         End If
  308.                 End If         
  309.         Next
  310.         ' 开始替换操作
  311.         nFileNum = 0
  312.         For i = 1 To n
  313.                 SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
  314.                 SaveFileName = GetRndFileName(SaveFileType)
  315.                 If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
  316.                         nFileNum = nFileNum + 1
  317.                         If nFileNum > 0 Then
  318.                                 sOriginalFileName = sOriginalFileName & "|"
  319.                                 sSaveFileName = sSaveFileName & "|"
  320.                                 sPathFileName = sPathFileName & "|"
  321.                         End If
  322.                         sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
  323.                         sSaveFileName = sSaveFileName & SaveFileName
  324.                         sPathFileName = sPathFileName & sContentPath & SaveFileName
  325.                         s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
  326.                 End If
  327.         Next
  328.  
  329.         ReplaceRemoteUrl = s_Content
  330. End Function
  331.  
  332. '================================================
  333. '作  用:保存远程的文件到本地
  334. '参  数:s_LocalFileName ------ 本地文件名
  335. '                s_RemoteFileUrl ------ 远程文件URL
  336. '返回值:True  ----成功
  337. '        False ----失败
  338. '================================================
  339. Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
  340.         Dim Ads, Retrieval, GetRemoteData
  341.         Dim bError
  342.         bError = False
  343.         SaveRemoteFile = False
  344.         'On Error Resume Next
  345.         Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
  346.         With Retrieval
  347.                 .Open "Get", s_RemoteFileUrl, False, "", ""
  348.                 .Send
  349.                 GetRemoteData = .ResponseBody
  350.         End With
  351.         Set Retrieval = Nothing
  352.  
  353.         If LenB(GetRemoteData) > nAllowSize*1024 Then
  354.                 bError = True
  355.         Else
  356.                 Set Ads = Server.CreateObject("Adodb.Stream")
  357.                 With Ads
  358.                         .Type = 1
  359.                         .Open
  360.                         .Write GetRemoteData
  361.                         .SaveToFile Server.MapPath(sUploadDir & s_LocalFileName), 2
  362.                         .Cancel()
  363.                         .Close()
  364.                 End With
  365.                 Set Ads=nothing
  366.         End If
  367.  
  368.         If Err.Number = 0 And bError = False Then
  369.                 SaveRemoteFile = True
  370.         Else
  371.                 Err.Clear
  372.         End If
  373. End Function
  374.  
  375. '================================================
  376. '作  用:检查组件是否已经安装
  377. '参  数:strClassString ----组件名
  378. '返回值:True  ----已经安装
  379. '        False ----没有安装
  380. '================================================
  381. Function IsObjInstalled(strClassString)
  382.         On Error Resume Next
  383.         IsObjInstalled = False
  384.         Err = 0
  385.         Dim xTestObj
  386.         Set xTestObj = Server.CreateObject(strClassString)
  387.         If 0 = Err Then IsObjInstalled = True
  388.         Set xTestObj = Nothing
  389.         Err = 0
  390. End Function
  391. %>
  392.  
  393.  
  394.  
  395.  
downloadUpload.asp Source code - Download Jie Yang v0.6.3 article system Source code
Related Source Codes/Software:
Jilin classification information release system v5.0 trial version - A ready-made classifieds site publishing system, h... 2016-09-21
Linyi CMS v6.5 market classification information - A. supply and demand information function: informa... 2016-09-21
Tesco discount net SQL version - And presentations, faster. 2016-09-21
- electronic enterprise website management system In a fully functional version - Super suitable for enterprise agents build a corpo... 2016-09-21
Rio mesh network hard disk system v3.0 - System functions: 1, increase the progress of Asp... 2016-09-21
Classified information network business in suzhou - Overall module: classification of supply and deman... 2016-09-21
NPOINT virtual host v1.7.0 formal version management system - The system main function is introduced 2016-09-21
IDC sales web site - Beautiful IDC sales web site source code 2016-09-21
Oo 126 CMS movie site system - This procedure ASP + ACC/ASP + SQL, using new kern... 2016-09-21
Pcook CMS bubble guest v3.0 SDCMS version - Developed by Asp+Access, and meet the needs of sma... 2016-09-21
CRYENGINE - CRYENGINE is a powerful real-time game development... 2017-06-11
postal - 2017-06-11
reactide - Reactide is the first dedicated IDE for React web ... 2017-06-11
rkt - rkt is a pod-native container engine for Linux. It... 2017-06-11
uWebSockets - Tiny WebSockets https://for... 2017-06-11
realworld - TodoMVC for the RealWorld - Exemplary fullstack Me... 2017-06-11
goreplay - GoReplay is an open-source tool for capturing and ... 2017-06-10
pyenv - Simple Python version management 2017-06-10
redux-saga - An alternative side effect model for Redux apps ... 2017-06-10
angular-starter - 2017-06-10

 Back to top