九乡新闻网自动化测试培训班:asp实现rar压缩和解压缩源代码
来源：百度文库 编辑：九乡新闻网 时间：2024/04/27 23:31:07
asp实现rar压缩和解压缩源代码
2008-11-04 11:59:23 来源: 【大 中 小】 评论：0 条 我要投稿 收藏本文 分享至微博站长交易（http://jy.chinaz.com）帮站长赚钱 虚拟主机评测+IDC导航=IDC123.COM
asp实现rar压缩和解压缩源代码,只要一个文件就可能搞定,asp压缩目录或文件,解压rar文件,删除特定文件等功能.此源码方便大家进行二次开发,分享出来.
以下是winrar.asp代码：
以下为引用的内容：
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
| 阿言在线winrar插件最新更新时间2006.5.17 [支持页面] |
|---|
| <% Server.ScriptTimeout=99999 Dim winrar,cmddir Winrar="C:\Program Files\WinRAR\Winrar.exe" ’Winrar.exe的路径Progra~1。 cmddir="%windir%\system32\cmd.exe" ’cmd.exe的路径 user="spubbs.com"’用户名 pwd="spubbs.com"’登陆、压缩、解压缩密码,出于安全考虑，请将此密码设置足够强壮 if request.Form("user")=user and request.Form("pwd")=pwd then response.write "本文件夹路径："&Server.Mappath(".")&" " 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%> <% ErrInfo end if else login() end if Sub ErrInfo if not isempty(Runcode) and Runcode=0 Then Response.Write("命令成功执行,您提交的命令如下： "& Cmd) elseif not isempty(Runcode) then Response.Write("命令执行失败！权限不够或者该程序无法在DOS状态下运行,您提交的命令如下： " & Cmd) else end if If Err Then Response.Write " "&err.description err.Clear End If %> <% 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() %> <%End sub%> |
| Powered By ：阿言 |