当前位置:96看吧 > 技术文档 > ASP编程 > 无组件ASP在线打包压缩程序

无组件ASP在线打包压缩程序

时间:2009/03/15
作者:佚名
来源:网络转载
查看:
标签:无组件asp

index.asp文件

<%  Option  Explicit  %>
<!--#include  file="asptar.asp"-->
<%
Response.charset="gb2312"
Response.Buffer  =  True
Response.Clear
Dim  Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar
Co=0
PH="../zip"  '文件路径  '压缩父目录下zip目录的所有文件
      Set  objTar  =  New  Tarball
      objTar.TarFilename="打包.rar"    '打包的名称
      objTar.Path=PH
      set  fsoBrowse=CreateObject("Scripting.FileSystemObject")
      Set  theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))
      Set  theSubFolders=theFolder.SubFolders
      GetFileList  theFolder,""
   
      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
Sub  GetFileList(Folderobject,path)
Dim  y,m
For  Each  y  in  Folderobject.Files
If  Path  <>""  Then
Temp=  Temp  &    path  &  y.Name&"|"
Else
Temp=  Temp  &  y.Name&"|"
End  If
        Co=Co+1
Next
Dim  NewPath
For  Each  m  In  Folderobject.SubFolders
If  path=""  Then
NewPath=M.name  &"/"
Else
NewPath=path  &  M.name  &"/"
End  If
GetFileList  m,NewPath
Next
End  Sub
%>

asptar.asp文件

<%

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

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"

    aFiles  =  objFiles.Items
    For  lTemp  =  0  to  UBound(aFiles)
        objInStream.Open
        objInStream.LoadFromFile  aFiles(lTemp)
        objInStream.Position  =  0
        TmpFileName  =replace(aFiles(lTemp),Server.Mappath(Path)&"\","")
        ExportFile  TmpFileName,objStream,objInStream
        objInStream.Close
    Next
    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))
    objStream.Position  =  0
    objStream.Type  =  1
    objStream.savetofile  Server.Mappath(Path)  &  "\"  &  TarFilename,2
    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.charset="gb2312"
    objOutStream.WriteText  Left(sFilename  &  String(100,Chr(0)),100)
    'objOutStream.charset="x-ansi"
    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
%>

上一篇:Asp的Session.codepage乱码问题
下一篇:ASP程序将网页中电话号码生成图片
页面举报
Report
关闭页面
Close
收藏页面
Favorites
分享页面
Share
版权信息:栏目内,站内会员所分享的全部“资源/素材/文章”,仅供学习与参考,版权为原作者所有。
下载提示:非注册用户每天可下载一个文件,已注册会员不受限制。
网友评论
数据载入中
验证码
  • 请您注意:
  • ·请不要在评论中含与内容无关的广告链接。
  • ·不良评论请用报告管理员,以利管理员及时删除。
  • ·遵守中华人民共和国的各项有关法律法规
  • ·承担一切因您的行为而直接或间接导致的民事或刑事法律责任
  • ·本站管理人员有权保留或删除评论中的任意内容
  • ·您在本站发表的作品,本站有权在网站内转载或引用
  • ·参与本评论即表明您已经阅读并接受上述条款
相关最新
相关热门