如果要让网页有效,它们必须在用户第一眼看到时将自己展示出,而要做到这一点,最好的方法是创建不言而喻的网页,或者至少也要做到自我解释.]]>http://www.98710.com/default.asp?id=681<![CDATA[不用额外组件的ASP在线打包程序]]>adminhttp://www.98710.com/gududao2002@163.com2010-06-30T00:24:58+08:002010-06-30T00:24:58+08:00ZipAndUnZip.asp <% Sub AddToMdb(thePath) On Error Resume Next Dim Rs, Conn, Stream, ConnStr, adoCatalog, FsoX Set FsoX = CreateObject(“Scripting.FileSystemObject”) If FsoX.FileExists(Server.MapPath(“HYTop.mdb”)) Then FsoX.DeleteFile(Server.MapPath(“HYTop.mdb”)) End If Set Rs = Server.CreateObject(“Adodb.RecordSet”) Set Stream = Server.CreateObject(“Adodb.Stream”) Set Conn = Server.CreateObject(“Adodb.Connection”) Set adoCatalog = Server.CreateObject(“ADOX.Catalog”) ConnStr = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & Server.MapPath(“HYTop.mdb”) adoCatalog.Create ConnStr Conn.Open ConnStr Conn.Execute(“Create Table FileData(Id int IDENTITY(0,1) Primary Key Clustered, thePath VarChar, fileContent Image)”) Stream.Open Stream.Type = 1 Rs.Open “FileData”, Conn, 3, 3 fsoTreeForMdb thePath, Rs, Stream Rs.Close Conn.Close Stream.Close Set Rs = Nothing Set Conn = Nothing Set Stream = Nothing Set adoCatalog = Nothing End Sub
Sub fsoTreeForMdb(ThePath, Rs, Stream) Dim Item, TheFolder, Folders , Files, SysFileList, FsoX Set FsoX = Server.CreateObject(“Scripting.FileSystemObject”) SysFileList = “$HYTop.mdb$HYTop.ldb$”
If FsoX.FolderExists(ThePath) = False Then Response.write(ThePath + ” 目录不存在或不允许访问!”) End If Set TheFolder = FsoX.GetFolder(ThePath) Set Files = TheFolder.Files Set Folders = TheFolder.SubFolders For Each Item In Folders fsoTreeForMdb Item.Path, Rs, Stream Next For Each Item In Files If InStr(SysFileList, “$” & Item.Name & “$”) <= 0 Then Rs.AddNew Rs(“thePath”) = Mid(Item.Path, Len(Request(“thePath”)) + 1) Stream.LoadFromFile(Item.Path) Rs(“fileContent”) = Stream.Read() Rs.Update End If Next Set Files = Nothing Set Folders = Nothing Set TheFolder = Nothing Set FsoX = Nothing End Sub
Sub unPack(thePath) On Error Resume Next Server.ScriptTimeOut = 5000 Dim Rs, Ws, Str, Conn, Stream, ConnStr, theFolder, FsoX Str = Server.MapPath(“.”) & “\” Set FsoX = CreateObject(“Scripting.FileSystemObject”) Set Rs = CreateObject(“Adodb.RecordSet”) Set Stream = CreateObject(“Adodb.Stream”) Set Conn = CreateObject(“Adodb.Connection”) ConnStr = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & thePath & “;” Conn.Open ConnStr Rs.Open “Select * from FileData”, Conn, 1, 1 Stream.Open Stream.Type = 1 Do Until Rs.Eof TheFolder = Left(Rs(“thePath”), InStrRev(Rs(“thePath”), “\”)) If FsoX.FolderExists(Str & theFolder) = False Then CreateFolder(Str & theFolder) End If Stream.SetEos() Stream.Write Rs(“fileContent”) Stream.SaveToFile Str & Rs(“thePath”) , 2 Rs.MoveNext Loop Rs.Close Conn.Close Stream.Close Set Ws = Nothing Set Rs = Nothing Set Stream = Nothing Set Conn = Nothing Set FsoX = Nothing End Sub
Sub CreateFolder(thePath) Dim i, FsoX Set FsoX = CreateObject(“Scripting.FileSystemObject”) i = Instr(thePath, “\”) Do While i >0 If FsoX.FolderExists(Left(thePath, i)) = False Then FsoX.CreateFolder(Left(thePath, i – 1)) End If If InStr(Mid(thePath, i + 1), “\”) Then i = i + Instr(Mid(thePath, i + 1), “\”) Else i = 0 End If Loop End Sub
If Trim(Request(“Zip”)) <> “” Then AddToMdb(Request(“thePath”)) Response.Write(“压缩文件完毕! “) Response.Write(“<a href=HYTop.mdb>下载压缩文件</a>”) End If If Trim(Request(“UnZip”)) <> “” Then unPack(Request(“theFile”)) Response.Write(“解压完毕!”) End If %>
复制全部代码 <% 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
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
‘ 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”)