線上打包和解包

<%

'=====================

'FSO線上壓縮解壓縮

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 + " 目錄不存在或不允許通路!")

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

Set Files = Nothing

Set Folders = Nothing

Set TheFolder = Nothing

Set FsoX = Nothing

Sub unPack(thePath)

Server.ScriptTimeOut = 5000

Dim Rs, Ws, Str, Conn, Stream, ConnStr, theFolder, FsoX

Str = Server.MapPath(".") & ""

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 & ";"

Rs.Open "Select * from FileData", Conn, 1, 1

Do Until Rs.Eof

TheFolder = Left(Rs("thePath"), InStrRev(Rs("thePath"), ""))

If FsoX.FolderExists(Str & theFolder) = False Then

   CreateFolder(Str & theFolder)

Stream.SetEos()

Stream.Write Rs("fileContent")

Stream.SaveToFile Str & Rs("thePath") , 2

Rs.MoveNext

Loop

Set Ws = Nothing

Sub CreateFolder(thePath)

Dim i, FsoX

i = Instr(thePath, "")

Do While i >0

If FsoX.FolderExists(Left(thePath, i)) = False Then

   FsoX.CreateFolder(Left(thePath, i - 1))

If InStr(Mid(thePath, i + 1), "") Then

   i = i + Instr(Mid(thePath, i + 1), "")

Else

   i = 0

If Trim(Request("Zip")) <> "" Then

AddToMdb(Request("thePath"))

Response.Write("壓縮檔案完畢! ")

Response.Write("<a href=HYTop.mdb>下載下傳壓縮檔案</a>")

If Trim(Request("UnZip")) <> "" Then

unPack(Request("theFile"))

Response.Write("解壓完畢!")

%>

<style type="text/css">

<!--

.STYLE1 {color: #FF0000}

.STYLE2 {

color: #FFFFFF;

font-weight: bold;

font-size: 14px;

}

*{font-size:12px;}

-->

</style>

<p> </p>

<form id="form1" name="form1" method="post" action="">

<table width="100%" height="25" border="0" cellpadding="0" cellspacing="1" bgcolor="#66CCCC">

    <tr>

      <td height="30" colspan="3" align="center"><span class="STYLE2">ASP 線上壓縮-解壓縮</span></td>

    </tr>

      <td width="35%" height="25" bgcolor="#FFFFFF">壓縮目錄(壓縮完成後預設為本程式目錄下 <span class="STYLE1">HYTop.mdb</span> 檔案)</td>

      <td width="41%" height="25" bgcolor="#FFFFFF">

        <input name="thePath" type="text" id="thePath" value="<% If Right(Server.MapPath("."), 1) <> "" Then Response.Write(Server.MapPath(".")) & "" Else Response.Write(Server.MapPath(".")) End If %>" size="60" /></td>

      <td width="24%" height="25" bgcolor="#FFFFFF"><input name="Zip" type="submit" id="Zip" value="線上壓縮" /></td>

      <td height="25" bgcolor="#FFFFFF">解壓縮檔案(預設為本程式目錄下 <span class="STYLE1">HYTop.mdb</span> 檔案)</td>

      <td height="25" bgcolor="#FFFFFF">  <input name="theFile" type="text" id="theFile" value="<%=Server.MapPath("HYTop.mdb")%>" size="60" /></td>

      <td height="25" bgcolor="#FFFFFF">

      <input name="UnZip" type="submit" id="UnZip" value="線上解壓縮" /></td>

</table>

</form>