您正在使用IPV4(34.204.180.223)访问本站 您本次共访问本站 1 次
用户名: 用QQ登录本站
密 码:
验证码:
首页 软件 编程 笑话 知识 公告 台风 日历 计算器 行情 简化版
文明驾车我带头,文明行路我带头,礼貌让座我带头      

【腾讯云】618云上GO!云服务器限时秒杀,1核2G首年95元!       [公益] 节省一分零钱 献出一份爱心 温暖世间真情      
广告位招租中
2021年 建军节 3
2021年 七夕节 16
2022年 元 旦 156
2022年 春 节 187
 
  • 本类新增
    本类热门文章
    您现在的位置:首页 >> ASP >> 内容
    ASP完美在线解压、压缩、删除文件代码
    内容摘要: %@LANGUAGE='VBSCRIPT' CODEPAGE='936'%title欢迎使用ASP在线解压,压缩-青岛星网 www.qdxw.net/titlebodyTABLE border=0 width=80% align=center cellspacing=1 cellpadding=3 style='FONT-FAMILY: Verdana;fo......
    <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

    <title>欢迎使用ASP在线解压,压缩-青岛星网 www.qdxw.net</title>

    <body>

    <TABLE border=0 width=80% align=center cellspacing=1 cellpadding=3 style="FONT-FAMILY: Verdana;font-size:14px;BORDER: #000000 1px solid;background-color:#f7f7f7">

    <tr>

    <th width="100%" height="24" bgcolor="#33CCFF">&nbsp;</th>

    </tr>

    <tr>

    <td bgcolor="#33CCFF">

    <%

    'www.qdxw.net 出品

    Server.ScriptTimeout=99999

    Dim winrar,cmddir

    Winrar="C:\Program Files\WinRAR\Winrar.exe" '压缩文件(Winrar)的地址

    cmddir="%windir%\system32\cmd.exe" 'cmd.exe(命令提示符)的地址

    user="qdxw" '本程序的用户名

    pwd="qdxw" '本程序的登陆、压缩、解压缩密码,请大家务必修改(至少8位以上的组合密码才够安全!)


    if request.Form("user")=user and request.Form("pwd")=pwd then

    response.write "本文件夹路径:"&Server.Mappath(".")&"<br>"

    from=request.Form("from")

    where=request.Form("where")

    if from<>"" and where<>"" then

    Dim a,b,Shell,Runing,Runcode,Cmd

    if instr(where,":")=0 then a=Server.mappath(""&where&"") else a=where

    if instr(from,":")=0 then b=Server.mappath(""&from&"") else b=from

    'response.Write b

    if right(b,1)<>"\" and left(right(b,4),1)<>"." then b=b&".rar"

    On Error Resume Next

    Set Shell = Server.CreateObject("WScript.Shell")

    if request.QueryString("action")=1 then '解压缩

    if not ReportFileStatus(b)then Response.Write("没有找到 "&b&"可能不存在!"):Response.End()

    Runing= cmddir&" /c """&winrar&""" x -ibck -t -y -o+ -p"&pwd&" " '设置运行解压缩的命令。

    Cmd=Runing&b&" "&a&"\"



    elseif request.QueryString("action")=0 then '压缩文件


    if (not ReportFileStatus(a)) and (not ReportFolderStatus(a)) then Response.Write("没有找到 "&a&"可能不存在!"):Response.End()

    Cmd= cmddir&" /c del /f /q "&b

    Runcode = Shell.Run(Cmd,1,True)

    Runing= cmddir&" /c """&winrar&""" a -ibck -y -ep -o+ -p"&pwd&" " '压缩。

    Cmd=Runing&b&" "&a

    else '删除文件

    Cmd= cmddir&" /c del /f /q "&b

    end if


    Runcode = Shell.Run(Cmd,1,True)

    Runing = Shell.Run(cmddir&" /c taskkill /im winrar.exe",1,false)

    Runing = Shell.Run(cmddir&" /c exit",1,false)

    Set Shell=nothing

    ErrInfo

    %>

    <%else%>


    <form name="frm" method="post" action="?action=1" style="BORDER: #d9d9d9 1px solid;background-color:#f7f7f7">

    --------------------------------------<strong>解压缩文件</strong>---------------------------------------

    <br>

    <br>

    请输入rar压缩文件地址:

    <input name="from" value="1.rar" size="50"><br>

    解压到:<input name="where" value="." size="50">

    文件夹请使用绝对路径且在最后加 "\" <br>

    <br>

    <input name="submit" type="submit" value=" 解 压 "><input type="hidden" name="user" value="<%=request.Form("user")%>">

    <input type="hidden" name="pwd" value="<%=request.Form("pwd")%>">

    </FORM>

    <form name="frm" method="post" action="?action=0" style="BORDER: #d9d9d9 1px solid;background-color:#f7f7f7">

    --------------------------------------<strong>压缩文件</strong>---------------------------------------<br>

    <br>

    请在此输入您要压缩文件地址:

    <input name="where" value="./data/dvbbs7#.mdb" size="50">

    您也可以输入文件夹<br>

    <br>

    存放路径及新文件名:<input name="from" value="../data/1.rar" size="50">

    自动覆盖同名文件<br>

    <br>

    <input name="submit" type="submit" value=" 压 缩 "><input type="hidden" name="user" value="<%=request.Form("user")%>">

    <input type="hidden" name="pwd" value="<%=request.Form("pwd")%>"></FORM>

    <%

    ErrInfo

    end if

    else

    login()

    end if


    Sub ErrInfo

    if not isempty(Runcode) and Runcode=0 Then

    Response.Write("操作成功执行,您提交的操作如下:<br>"& Cmd)

    elseif not isempty(Runcode) then

    Response.Write("操作执行失败!可能您的权限不够或者该程序无法在DOS(命令提示符)下运行,您提交的操作如下:<br>" & Cmd)

    else

    end if

    If Err Then

    Response.Write "<br>"&err.description

    err.Clear

    End If

    %>

    <form name="frm" method="post" action="?action=2" style="BORDER: #d9d9d9 1px solid;background-color:#f7f7f7">

    --------------------------------------<strong>删除文件</strong>---------------------------------------<br>

    <br>

    请输入要删除文件地址:<input name="from" size="50" value=<%=from%>>

    文件夹请使用绝对路径且在最后加“\” <br>

    <input type="hidden" name="where" value=<%if where<>"" then response.Write where else response.Write "."%>>

    <br>

    <input name="submit" type="submit" value=" 删 除 ">

    <input type="hidden" name="user" value="<%=request.Form("user")%>">

    <input type="hidden" name="pwd" value="<%=request.Form("pwd")%>">

    </FORM>

    <br>

    <%

    End Sub

    Function ReportFileStatus(filespec)

    Dim fso

    Set fso = CreateObject("Scripting.FileSystemObject")

    ReportFileStatus=false

    If (fso.FileExists(filespec)) Then ReportFileStatus = true

    Set fso =nothing

    End Function

    Function ReportFolderStatus(fldr)

    Dim fso

    Set fso = CreateObject("Scripting.FileSystemObject")

    ReportFolderStatus=false

    If (fso.FolderExists(fldr)) Then ReportFolderStatus = true

    Set fso =nothing

    End Function

    Sub login()

    %>

    <form name="frm" method="post" action="?action=2" style="BORDER: #d9d9d9 1px solid;background-color:#f7f7f7">

    <p>--------------------------------------<strong>登陆系统</strong>---------------------------------------<br>

    <br>

    用户名:

    <input name="user" value="test">

    </p>

    密 码:

    <input name="pwd" type="password" id="pwd">

    <br>

    <br>

    <input name="submit" type="submit" value=" 登陆 ">

    </FORM>

    <%End sub%>

    </td>

    </tr>

    </table>

    </body>

    版权声明:本内容来源于互联网,如有侵犯您的版权,请联系站长,本站收到您的信息后将及时处理。
    上一篇:ASP正则判断密码只能输入字母数字下划线 下一篇:ASP根据自定义名称生成目录的程序
    发布日期:2021/7/11
    手机扫二维码直达本页
    发布时间:10:33:59
    点击:229
    录入:齐天大圣
    相关文章
    Baidu

    YiJiaCMS V5.9 Build 21.7.20(MSSQL) 闽ICP备05000814号-1
    本空间由景安网络提供,百度云加速提供加速防护
    ©2000-2021