删除文章时，同时删除上传文件 ASP函数代码

用了eWebEditor，编辑文章很方便，但如果要删除，内容中的图片可能没有都存到数据库的指定字段里面，所以就使得程序文件越来越大，今天给大家个函数，可以在删除文章时，同时把上传的文件也删除。
VB code

<%

  '***********************************************

'函数名：getPicUrl

'作  用：获得信息里的图片地址

'参  数：str  ----信息

'***********************************************

function getPicUrl(str)

    dim content,regstr,url

    content=str&""

    'regstr="src=.+?.(gif|jpg|bmp|doc)"

    regstr="UploadFiles/.+?.(gif|jpg|bmp|doc)"

    'url=Replace(Replace(Replace(RegExp_Execute(regstr,content),"'",""),"""",""),"src=","")

     url=Replace(Replace(Replace(RegExp_Execute(regstr,content),"'",""),"""",""),"/UploadFiles/","")

    getPicUrl=url

end function



Function RegExp_Execute(patrn, strng)

Dim regEx, Match, Matches,values '建立变量。

Set regEx = New RegExp '建立正则表达式。

regEx.Pattern = patrn '设置模式。

regEx.IgnoreCase = true '设置是否区分字符大小写。

regEx.Global = True '设置全局可用性。

Set Matches = regEx.Execute(strng) '执行搜索。

For Each Match in Matches '遍历匹配集合。

values=values&Match.Value&","

Next

RegExp_Execute = values

End Function



'***********************************************

'函数名：DeleteFile

'作  用：删除文件

'参  数：file  ----文件路径

'***********************************************

Function DeleteFile(file)

dim fso

Set fso = CreateObject("scripting.filesystemobject")

'if fso.fileExists(file) then

  fso.DeleteFile server.MapPath(file)

  'Else

   ' response.Write(" 文件不存在！"）

'end if

Set fso = nothing

End Function



%>

<% 

iii=0

typeid=request("typeid")

pageon=request("pageon")

type_name=request("typename")

selectcount=request("selectcount")

for ii=1 to selectcount

id=request("cid"&ii)

if id<>"" then



'***********************************************

'函数名：Delete

'作  用：删除文件

'参  数：file  ----文件路径

'***********************************************

set rsD=server.CreateObject("adodb.recordset")

sqlD = "select * from content_table where id = "&id&""

   rsD.open sqlD,con,1,3

   if rsD.bof and rsD.eof then

      Alert 1,"错误的参数!",""

      response.End()

   else

      dim picUrl,picUrl1

      dim picUrlArray

      dim x,y

      picUrl = getPicUrl(rsD("content"))

      

      '删除形象照片代码开始  

     if rsD("prdPic")<>"" then

     picUrl1 = replace(rsD("prdPic"),"../","/")

             DeleteFile(picUrl1)

    'response.Write("不为空")    

      end if

    '删除形象照片代码结束  

    

      if picUrl <> "" then

         picUrl = left(picUrl,len(picUrl)-1)

         picUrlArray = split(picUrl,",")

         for x = 0 to ubound(picUrlArray)

          if instr(picUrlArray(x),"/UploadFiles/") > 0 then

                          DeleteFile(picUrlArray(x))

            end if

         next

      end if

      

      rsD.delete

   end if

   rsD.close





strSQL="delete from content_Table where id ="&id

         CmdBegin adcmdtext,strSQL

        CmdExec()

iii=1%>

<%

end if

next

if iii=1 then%>

<script>

alert("已永久删除！")

location.href="info.asp?typeid=<%=typeid%>&pageon=<%=pageon%>&typename=<%=type_name%>"

</script>

<%else%>

<script>

alert("删除失败！")

history.back()

</script>

<%end if%>

删除文章时，同时删除上传文件 ASP函数代码

相关内容