ASP生成静态页面并按日期建立路径存放

Function GetPage(url) 
dim Retrieval
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False ', "", ""
.Send
GetPage = BytesToBstr(.ResponseBody)
End With
Set Retrieval = Nothing
End Function

'把数据流转换为字符，这可是关键
Function BytesToBstr(body)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "GB2312"
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

sub writeShtml(htmlpath,strHTML)
'如果htmlpath为空则是生成新文件，否则为修改
    dim fso,CrFi
    Set fso=Server.CreateObject("scripting.FileSystemObject")
    if htmlpath="" then
        randomize 
        htmlpath=createPath("bbb")&"\"&replace(formatdatetime(now(),vbshorttime),":","")&int((998 * rnd) + 1)&".shtml" 
    end if
    if fso.FileExists(htmlpath) then fso.DeleteFile(htmlpath)
    Set CrFi=fso.CreateTextFile(htmlpath)
    CrFi.writeline(strHTML)
    set fso=nothing
    set CrFi=nothing    
end sub

function createPath(forder)
'forder为指定目录，在指定目录下按日期创建文件夹
    dim calcPath
    if forder<>"" then calcPath = forder&"-"&formatdatetime(now(),vbshortdate) else calcPath = formatdatetime(now(),vbshortdate)
    
    dim fso
    set fso = server.CreateObject("scripting.FileSystemObject")
    absPath = Replace(calcPath, "-", "\")
    dim pathNames
    pathNames = Split(absPath, "\")
    dim i
    dim curPath
    curPath = server.MapPath("\")
    for i = 0 to UBound(pathNames)
       curPath = curPath & "\" & pathNames(i)
       if not fso.FolderExists(curPath) then fso.CreateFolder(curPath) end if
    next
    createPath=curPath
end function

dim str

str=GetPage("http://localhost:801/temp.asp")
str=replace(str,"{$top$}","<!--#include file=""temp2.html""-->")
call writeShtml("F:\pet\bbb\2008\1\22\15137457.shtml",str)