服务器用WScript.Shell组件调用winrar中的rar.exe，在代码的同目录要上传cmd.exe和rar.exe 



用法：rar.asp?path=要压缩的文件夹&rarname=压缩后的文件名&includefolder=包括子文件夹就不会空 

<%

'用法http://xx/rar.asp?path=要压缩的文件夹&rarname=压缩后的文件名&includefolder=包插子文件夹就不会空，

on error resume next

AppPath=server.mappath(".")&"/" '存放RAR.EXE和CMD.EXE的路径

zipfolder=server.mappath(request("path"))&"/" '要压缩的文件或文件夹

rarfile = request("rarname")

thispath = server.mappath(".")&"/"

if zipfolder<>"" and rarfile<>"" then

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

if err.number<>0 then

response.write "服务器不支持"

response.end

end if

if request("includefolder")<>"" then

cmd= thispath&"cmd.exe /c "&thispath&"rar.exe a -ep1 -r -t -o+  "&thispath&rarfile&"  "& zipfolder &""

else

cmd= thispath&"cmd.exe /c "&thispath&"rar.exe a -ep1 -t -o+  "&thispath&rarfile&"  "& zipfolder &""

end if

'response.write cmd

RetCode = Shell.Run(cmd,1, True)

response.write "<a href='"&rarfile&"'>"&rarfile&"</a>"

if err.number<>0 then

response.write "<a href='"&rarfile&"'>"&rarfile&"</a>"

else

response.write err.description

end if

else

response.write "没有参数"

end if

%>

Function  downloadFile(strFile)    

'  make  sure  you  are  on  the  latest  MDAC  version  for  this  to  work    

'  -------------------------------------------------------------     

'  get  full  path  of  specified  file    

strFilename  =  server.MapPath(strFile)   

'  clear  the  buffer    

Response.Buffer  =  True    

Response.Clear    

'  create  stream    

Set  s  =  Server.CreateObject("ADODB.Stream")    

s.Open    

'  Set  as  binary    

s.Type  =  1    

'  load  in  the  file    

on  error  resume  next    

'  check  the  file  exists    

Set  fso  =  Server.CreateObject("Scripting.FileSystemObject")    

if  not  fso.FileExists(strFilename)  then    

    Response.Write("<h1>Error:</h1>"  &  strFilename  &  "  文件不存在<p>")    

    Response.End 

end  if    

'  get  length  of  file    

Set  f  =  fso.GetFile(strFilename)    

intFilelength  =  f.size   



s.LoadFromFile(strFilename)    

if  err  then    

   Response.Write("<h1>Error:文件下载错误  </h1>""<p>")    

   Response.End    

end  if    

'  send  the  headers  to  the  users  browser    

Response.AddHeader  "Content-Disposition",  "attachment;  filename="  &  f.name    

Response.AddHeader  "Content-Length",  intFilelength    

Response.CharSet  =  "UTF-8"    

Response.ContentType  =  "application/octet-stream"    

 

'  output  the  file  to  the  browser  

Response.BinaryWrite  s.Read    

Response.Flush    

'  tidy  up    

s.Close    

Set  s  =  Nothing    

End  Function