用ASP实现方式在线压缩与解压缩功能代码实用指南

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>











 

　

<%
Server.ScriptTimeout=99999
Dim winrar,cmddir
Winrar="C:\Program Files\WinRAR\Winrar.exe" '压缩文件(Winrar)的地址
cmddir="%windir%\system32\cmd.exe" 'cmd.exe(命令提示符)的地址
user="csisp" '本程序的用户名
pwd="csisp" '本程序的登陆、压缩、解压缩密码,请大家务必修改(至少8位以上的组合密码才够安全!)

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%>


--------------------------------------解压缩文件---------------------------------------




请输入rar压缩文件地址：


解压到：
文件夹请使用绝对路径且在最后加 "\" 



">
">


--------------------------------------压缩文件---------------------------------------



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

您也可以输入文件夹



存放路径及新文件名：
自动覆盖同名文件



">
">

<%
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
%>

--------------------------------------删除文件---------------------------------------



请输入要删除文件地址：>
文件夹请使用绝对路径且在最后加“\” 

"" then response.Write where else response.Write "."%>>



">
">



<%
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%>
 Copyright ©2008  脚本之家

<%
'main文件夹中包含cmd.exe rar.exe 例如：要压缩的文件（*.mdb)
'压缩后的存放目录为main/data.rar
on error resume next
unzip_path=Server.mappath("main")&"/"
Set WshShell = server.CreateObject("Wscript.Shell")
IsSuccess = WshShell.Run ("winrar a "&unzip_path&"data 
"&unzip_path&"*.mdb",1, False)
'WinRAR <命令> -<开关1> -<开关N> <压缩文件> <文件...> <@列表文件...> 
<解压路径/>
'命令: A - 添加到压缩文件中
if IsSuccess = 0 Then
Response.write " 命令成功执行！"
else
Response.write " 命令执行失败！权限不够或者该程序无法运行"
end if
if err.number <> 0 then
Response.Write "
错误号码：" & Err.number
Response.Write "
原因：" & Err.description
Response.Write "
错误来源：" & Err.Source
Response.Write 
end if
%>

<%
'main文件夹中包含cmd.exe rar.exe 要解压缩的文件（*.rar) 
'解压缩后的存放目录为main
on error resume next
unzip_path=Server.mappath("main")&"/"
Set WshShell = server.CreateObject("Wscript.Shell")
IsSuccess = WshShell.Run ("winrar x -r -o+ "&unzip_path&"*.rar 
"&unzip_path&"",1, False)
'WinRAR <命令> -<开关1> -<开关N> <压缩文件> <文件...> <@列表文件...> 
<解压路径/>
'命令: X - 从压缩文件中全路径解压文件
'开关: -R - 连同子文件夹
'开关: -O+ - 覆盖已经存在的文件
'开关: -O- - 不覆盖已经存在的文件
if IsSuccess = 0 Then
Response.write " 命令成功执行！"
else
Response.write " 命令执行失败！权限不够或者该程序无法运行"
end if
if err.number <> 0 then
Response.Write "
错误号码：" & Err.number
Response.Write "
原因：" & Err.description
Response.Write "
错误来源：" & Err.Source
Response.Write 
end if
%>