侯体宗的博客
  • 首页
  • Hyperf版
  • beego仿版
  • 人生(杂谈)
  • 技术
  • 关于我
  • 更多分类
    • 文件下载
    • 文字修仙
    • 中国象棋ai
    • 群聊
    • 九宫格抽奖
    • 拼图
    • 消消乐
    • 相册

不用WinRar只有asp将网络空间上的文件打包下载

Windows  /  管理员 发布于 5年前   236



<%@ Language=VBScript %>
<% Option Explicit %>
<!--#include file="asptar.asp"-->
<%
Response.Buffer = True
Response.Clear
Dim Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar
Co=0
PH="./UpFile" '文件路径 '压缩Upfile下的所有文件
   Set objTar = New Tarball
   objTar.TarFilename="LvBBS_UpdateFile.rar"  '打包的名称
   objTar.Path=PH
   set fsoBrowse=CreateObject("Scripting.FileSystemObject")
   Set theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))
   Set theSubFolders=theFolder.SubFolders
   For Each T in theFolder.Files
      Temp= Temp & T.Name & "|"
      Co=Co+1
   Next
   For Each x In theSubFolders
      For Each i In X.Files
         Temp= Temp &  X.Name&"/"&i.Name&"|"
         Co=Co+1
      Next
   Next
   If Co<1 Then
      Response.Write "暂时没有可更新的文件下载"
   'objTar.AddMemoryFile "Sorry.txt","Not File!"
   Else
      Temp=Left(Temp,Len(Temp)-1)
      FilePath=Split(Temp,"|")
      For s=0 To Ubound(FilePath)
        objTar.AddFile Server.Mappath(PH&"/"&FilePath(s))
      Next
   If Response.IsClientConnected Then
        objTar.WriteTar
        Response.Flush
   End If
   End If
   Set ObjTar = Nothing
   Set fsoBrowse= Nothing
   Set theFolder = Nothing
   Set theSubFolders = Nothing

%>

asptar.asp

<%
' UNIX Tarball creator
' ====================
' Author: Chris Read
' Version: 1.0.1
' ====================
'
' This class provides the ability to archive multiple files together into a single
' distributable file called a tarball (The TAR actually stands for Tape ARchive).
' These are common UNIX files which contain uncompressed data.
'
' So what is this useful for? Well, it allows you to effectively combine multiple
' files into a single file for downloading. The TAR files are readable and extractable
' by a wide variety of tools, including the very widely distributed WinZip.
'
' This script can include two types of data in each archive, file data read from a disk,
' and also things direct from memory, like from a string. The archives support files in 
' a binary structure, so you can store executable files if you need to, or just store
' text.
'
' This class was developed to assist me with a few projects and has grown with every
' implementation. Currently I use this class to tarball XML data for archival purposes
' which allows me to grab 100's of dynamically created XML files in a single download.
'
' There are a small number of properties and methods, which are outlined in the
' accompanying documentation.
'
Class Tarball
Public TarFilename   ' Resultant tarball filename

Public UserID    ' UNIX user ID
Public UserName    ' UNIX user name
Public GroupID    ' UNIX group ID
Public GroupName   ' UNIX group name

Public Permissions   ' UNIX permissions

Public BlockSize   ' Block byte size for the tarball (default=512)

Public IgnorePaths   ' Ignore any supplied paths for the tarball output
Public BasePath    ' Insert a base path with each file
Public Path

' Storage for file information
Private objFiles,TmpFileName
Private objMemoryFiles

' File list management subs, very basic stuff
Public Sub AddFile(sFilename)
  objFiles.Add sFilename,sFilename
End Sub

Public Sub RemoveFile(sFilename)
  objFiles.Remove sFilename
End Sub

Public Sub AddMemoryFile(sFilename,sContents)
  objMemoryFiles.Add sFilename,sContents
End Sub

Public Sub RemoveMemoryFile(sFilename)
  objMemoryFiles.Remove sFilename
End Sub

' Send the tarball to the browser
Public Sub WriteTar()
  Dim objStream, objInStream, lTemp, aFiles

  Set objStream = Server.CreateObject("ADODB.Stream") ' The main stream
  Set objInStream = Server.CreateObject("ADODB.Stream") ' The input stream for data

  objStream.Type = 2
  objStream.Charset = "x-ansi" ' Good old extended ASCII
  objStream.Open

  objInStream.Type = 2
  objInStream.Charset = "x-ansi"

  ' Go through all files stored on disk first
  aFiles = objFiles.Items

  For lTemp = 0 to UBound(aFiles)
   objInStream.Open
   objInStream.LoadFromFile aFiles(lTemp)
   objInStream.Position = 0
   'ExportFile aFiles(lTemp),objStream,objInStream
             TmpFileName =replace(aFiles(lTemp),Server.Mappath(Path)&"\","")
    ExportFile TmpFileName,objStream,objInStream
   objInStream.Close
  Next

  ' Now add stuff from memory
  aFiles = objMemoryFiles.Keys

  For lTemp = 0 to UBound(aFiles)
   objInStream.Open
   objInStream.WriteText objMemoryFiles.Item(aFiles(lTemp))
   objInStream.Position = 0
   ExportFile aFiles(lTemp),objStream,objInStream
   objInStream.Close
  Next

  objStream.WriteText String(BlockSize,Chr(0))

  ' Rewind the stream
  ' Remember to change the type back to binary, otherwise the write will truncate
  ' past the first zero byte character.
  objStream.Position = 0
  objStream.Type = 1
  ' Set all the browser stuff
  Response.AddHeader "Content-Disposition","filename=" & TarFilename
  Response.ContentType = "application/x-tar"
  Response.BinaryWrite objStream.Read

  ' Close it and go home
  objStream.Close
  Set objStream = Nothing
  Set objInStream = Nothing
End Sub

' Build a header for each file and send the file contents
Private Sub ExportFile(sFilename,objOutStream,objInStream)
  Dim lStart, lSum, lTemp

  lStart = objOutStream.Position ' Record where we are up to

  If IgnorePaths Then
   ' We ignore any paths prefixed to our filenames
   lTemp = InStrRev(sFilename,"\")
   if lTemp <> 0 then
    sFilename = Right(sFilename,Len(sFilename) - lTemp)
   end if
   sFilename = BasePath & sFilename
  End If

  ' Build the header, everything is ASCII in octal except for the data
  objOutStream.WriteText Left(sFilename & String(100,Chr(0)),100)
  objOutStream.WriteText "100" & Right("000" & Oct(Permissions),3) & " " & Chr(0) 'File mode
  objOutStream.WriteText Right(String(6," ") & CStr(UserID),6) & " " & Chr(0) 'uid
  objOutStream.WriteText Right(String(6," ") & CStr(GroupID),6) & " " & Chr(0) 'gid
  objOutStream.WriteText Right(String(11,"0") & Oct(objInStream.Size),11) & Chr(0) 'size
  objOutStream.WriteText Right(String(11,"0") & Oct(dateDiff("s","1/1/1970 10:00",now())),11) & Chr(0) 'mtime (Number of seconds since 10am on the 1st January 1970 (10am correct?)
  objOutStream.WriteText "        0" & String(100,Chr(0)) 'chksum, type flag and link name, write out all blanks so that the actual checksum will get calculated correctly
  objOutStream.WriteText "ustar  "  & Chr(0) 'magic and version
  objOutStream.WriteText Left(UserName & String(32,Chr(0)),32) 'uname
  objOutStream.WriteText Left(GroupName & String(32,Chr(0)),32) 'gname
  objOutStream.WriteText "         40 " & String(4,Chr(0)) 'devmajor, devminor
  objOutStream.WriteText String(167,Chr(0)) 'prefix and leader
  objInStream.CopyTo objOutStream ' Send the data to the stream

  if (objInStream.Size Mod BlockSize) > 0 then
   objOutStream.WriteText String(BlockSize - (objInStream.Size Mod BlockSize),Chr(0)) 'Padding to the nearest block byte boundary
  end if

  ' Calculate the checksum for the header
  lSum = 0  
  objOutStream.Position = lStart

  For lTemp = 1 To BlockSize
   lSum = lSum + (Asc(objOutStream.ReadText(1)) And &HFF&)
  Next

  ' Insert it
  objOutStream.Position = lStart + 148
  objOutStream.WriteText Right(String(7,"0") & Oct(lSum),7) & Chr(0)

  ' Move to the end of the stream
  objOutStream.Position = objOutStream.Size
End Sub

' Start everything off
Private Sub Class_Initialize()
  Set objFiles = Server.CreateObject("Scripting.Dictionary")
  Set objMemoryFiles = Server.CreateObject("Scripting.Dictionary")

  BlockSize = 512
  Permissions = 438 ' UNIX 666

  UserID = 0
  UserName = "root"
  GroupID = 0
  GroupName = "root"

  IgnorePaths = False
  BasePath = ""

  TarFilename = "new.tar"
End Sub

Private Sub Class_Terminate()
  Set objMemoryFiles = Nothing
  Set objFiles = Nothing
End Sub
End Class
%>


  • 上一条:
    windows2003下使用asp WScript.Shell的设置方法
    下一条:
    在Win2003 64位下ASP无法连接Access数据库
  • 昵称:

    邮箱:

    0条评论 (评论内容有缓存机制,请悉知!)
    最新最热
    • 分类目录
    • 人生(杂谈)
    • 技术
    • linux
    • Java
    • php
    • 框架(架构)
    • 前端
    • ThinkPHP
    • 数据库
    • 微信(小程序)
    • Laravel
    • Redis
    • Docker
    • Go
    • swoole
    • Windows
    • Python
    • 苹果(mac/ios)
    • 相关文章
    • Windows 10的告别:2025年10月14日,一段时代的终结(0个评论)
    • windows 11激活_Win11 KMS激活流程步骤(1个评论)
    • 安装Windows 11系统的注意了,看看你的cpu是否在微软兼容列表排除中(1个评论)
    • 微软将于2022年9月20日推送Windows11 22H2新版本,推测2024发布windows 12(0个评论)
    • windows11系统中可以关闭禁止的服务及介绍(1个评论)
    • 近期文章
    • 智能合约Solidity学习CryptoZombie二课:让你的僵尸猎食(0个评论)
    • 智能合约Solidity学习CryptoZombie第一课:生成一只你的僵尸(0个评论)
    • 在go中实现一个常用的先进先出的缓存淘汰算法示例代码(0个评论)
    • 在go+gin中使用"github.com/skip2/go-qrcode"实现url转二维码功能(0个评论)
    • 在go语言中使用api.geonames.org接口实现根据国际邮政编码获取地址信息功能(1个评论)
    • 在go语言中使用github.com/signintech/gopdf实现生成pdf分页文件功能(0个评论)
    • gmail发邮件报错:534 5.7.9 Application-specific password required...解决方案(0个评论)
    • 欧盟关于强迫劳动的规定的官方举报渠道及官方举报网站(0个评论)
    • 在go语言中使用github.com/signintech/gopdf实现生成pdf文件功能(0个评论)
    • Laravel从Accel获得5700万美元A轮融资(0个评论)
    • 近期评论
    • 122 在

      学历:一种延缓就业设计,生活需求下的权衡之选中评论 工作几年后,报名考研了,到现在还没认真学习备考,迷茫中。作为一名北漂互联网打工人..
    • 123 在

      Clash for Windows作者删库跑路了,github已404中评论 按理说只要你在国内,所有的流量进出都在监控范围内,不管你怎么隐藏也没用,想搞你分..
    • 原梓番博客 在

      在Laravel框架中使用模型Model分表最简单的方法中评论 好久好久都没看友情链接申请了,今天刚看,已经添加。..
    • 博主 在

      佛跳墙vpn软件不会用?上不了网?佛跳墙vpn常见问题以及解决办法中评论 @1111老铁这个不行了,可以看看近期评论的其他文章..
    • 1111 在

      佛跳墙vpn软件不会用?上不了网?佛跳墙vpn常见问题以及解决办法中评论 网站不能打开,博主百忙中能否发个APP下载链接,佛跳墙或极光..
    • 2018-01
    • 2018-06
    • 2020-06
    • 2021-06
    • 2021-07
    • 2022-01
    • 2022-04
    • 2022-08
    • 2023-08
    • 2023-10
    • 2024-04
    Top

    Copyright·© 2019 侯体宗版权所有· 粤ICP备20027696号 PHP交流群

    侯体宗的博客