asp打包类(2)

 str = str & b(i)&">"&Replace(a(i),rootpath,"")&vbCrLf
 next
 str = CStr(Right("000000000"&len(str),10)) & str
 buf = TextToStream(str)
 s.Position = 0
 s.Write buf
 s1.Position = 0
 s.Write s1.Read
 s.SetEOS
 s.SaveToFile(packname)
 End Sub

 Public Sub UnPack

 If Not fso.FolderExists(rootpath) Then
 fso.CreateFolder(rootpath)
 End If
 Dim size
 '转换文件大小
 s.LoadFromFile(packname)
 size = CInt(StreamToText(s.Read(10)))
 str = StreamToText(s.Read(size))
 arr = Split(str,vbCrLf)

 for i=0 to Ubound(arr)-1
 arrFile = Split(arr(i),">")
 If arrFile(0) < 0 Then
 If Not fso.FolderExists(rootpath&arrFile(1)) Then
 fso.CreateFolder(rootpath&arrFile(1))
 End If
 ElseIf arrFile(0) >= 0 Then
 If fso.FileExists(rootpath&arrFile(1)) Then
 fso.DeleteFile(rootpath&arrFile(1))
 End If
 s1.Position = 0
 buf = s.Read(arrFile(0))
 If Not IsNull(buf) Then s1.Write(buf)
 s1.SetEOS
 s1.SaveToFile(rootpath&arrFile(1))
 End If
 Next
 End Sub

 Public Function StreamToText(stream)
 If IsNull(stream) Then
 StreamToText = ""
 Else
 Set sm = server.CreateObject("ADODB.Stream"):sm.Open:sm.Type = 1
 sm.Write(stream)
 sm.Position = 0
 sm.Type = 2
 sm.charset = "gb2312"
 sm.Position = 0
 StreamToText = sm.ReadText()
 sm.Close:Set sm = Nothing
 End If
 End Function

 Public Function TextToStream(text)
 If text="" Then
 TextToStream = "" '这里该如何写？空流？
 Else
 Set sm = server.CreateObject("ADODB.Stream"):sm.Open:sm.Type = 2:sm.charset = "gb2312"
 sm.WriteText(text)
 sm.Position = 0
 sm.Type = 1
 sm.Position = 0
 TextToStream = sm.Read
 sm.Close:Set sm = Nothing
 End If
 End Function
End Class
</script>