程序修改 订阅所有【程序修改】的日志

新云CMS4.0SP2后台文件上传后自动添加下载地址

编辑:dnawo 日期:2010-09-11

字体大小: 小 中 大
最终效果如下图所示：



新云CMS4.0SP2后台文件上传后自动添加下载地址方法：

①.打开"admin\soft\admin_post.asp"，找到如下代码并修改(绿色新增)：

复制内容到剪贴板程序代码 程序代码
<script language="javascript">
function setid() {
     str='';
     if(!window.myform.no.value)
     window.myform.no.value=1;
     for(i=2;i<=window.myform.no.value;i++)
     str+=''+'<%=SelDownServer(1,"downsid")%><input type="text" name="DownAddress" id="DownAddress'+i+'" size="50" value="">-<input type="text" name="SiteName" value="下载地址'+i+'" size="15"><br>';
     window.upid.innerHTML=str;
     /*if (i==1) {
        downsite.style.display='none';
     }else{
        downsite.style.display='';
     }*/
}
</script>


②.打开"admin\upload.asp'，增加函数OutFileUrl：

复制内容到剪贴板程序代码 程序代码
Sub OutFileUrl(url)
    Response.Write "<script language=javascript>" & vbCrLf
    Response.Write "try{" & vbCrLf
    Response.Write "var havspace = false;" & vbCrLf
    Response.Write "var f = parent.document.forms[0];" & vbCrLf
    Response.Write "if(!f.no.value)f.no.value=1;" & vbCrLf
    Response.Write "for(var i=1;i<=f.no.value;i++)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "    if(f['DownAddress'+i].value=='')" & vbCrLf
    Response.Write "    {" & vbCrLf
    Response.Write "        f['DownAddress'+i].value = '" & url & "';" & vbCrLf
    Response.Write "        havspace = true;" & vbCrLf
    Response.Write "        break;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    'Response.Write "if(!havspace)" & vbCrLf
    'Response.Write "{" & vbCrLf
    'Response.Write "    f.no.value = parseInt(f.no.value) + 1;" & vbCrLf
    'Response.Write "    parent.setid();" & vbCrLf
    'Response.Write "    f['DownAddress'+parseInt(f.no.value)].value = '" & url & "';" & vbCrLf
    'Response.Write "}" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "catch(e){alert(e.message);}" & vbCrLf
    Response.Write "</script>" & vbCrLf
End Sub

再找到下边代码并修改(绿色新增)：

复制内容到剪贴板程序代码 程序代码
<%
sAction = UCase(Trim(Request.QueryString("action")))
If sAction = "SAVE" Then
    If Not ChkAdmin("UploadFile") Then
        Response.Write ("<script>alert('对不起!您没有上传文件的权限');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
    SaveFilePath = UploadPath & SaveFilePath
    If m_strType = "NEWS" Then
        Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
        Response.Write "<script type=""text/javascript"">" & vbCrLf
        Response.Write "doInterfaceUpload('" & SaveFilePath & "');" & vbCrLf
        Response.Write "</script>" & vbCrLf
    ElseIf m_strType = "INDEX" Then
        Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
    Else
        If sType = "IMAGE" And m_intshow = 1 Then
            Call addUploadItem(m_strFileExt,m_strRootPath & SaveFilePath,SaveFilePath)
        Else
            If sType = "FILE" Then
                Call OutFilesize(m_intMaxsize)
                Call OutFileUrl(m_strRootPath & SaveFilePath)
            Else
                Call OutScript(SaveFilePath)
            End If
        End If
    End If
%>


上一篇: 中国竹子之乡
下一篇: ASP调用XSLTemplate对象将XML转换为HTML示例
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
最新日志:
评论: 0 | 引用: 0 | 查看次数: 4234
发表评论
请登录后再发表评论！