ASP+模板生成Word、Excel、html的代碼第1/2頁

%
'歡迎與我交流和學(xué)習(xí)
'作者：幸福的子彈
'BLOG:http://mysheji.com/blog
'E-mail:zhaojiangang@gmail.com
'QQ:37294812
'-----------------------------------------------------------------------------
'開啟容錯(cuò)機(jī)制 
on error resume next 
'功能，檢測(cè)服務(wù)器是否支持指定組件
Function object_install(strclassstring)
  on error resume next
  object_install=false
  dim xtestobj
  set xtestobj=server.createobject(strclassstring)
  if -2147221005 > Err then object_install=true
  set xtestobj=nothing
end function
if object_install("Scripting.FileSystemobject")=false then
    Response.Write "div style='font-size:12px;color:#333;height:20px;line-height:20px;border:1px solid #DDCF8F;padding:6px;background:#FFFFED;font-family:verdana'>對(duì)不起，您的空間不支持FSO組件，請(qǐng)與管理員聯(lián)系!/div>"
    Response.End
end if
if object_install("adodb.stream")=false then
    Response.Write "div style='font-size:12px;color:#333;height:20px;line-height:20px;border:1px solid #DDCF8F;padding:6px;background:#FFFFED;font-family:verdana'>對(duì)不起，您的空間不支持adodb.stream功能，請(qǐng)與管理員聯(lián)系!/div>"
    Response.End
end if
'-----------------------------------------------------------------------------
'函數(shù)名稱:ReadTextFile
'作用:利用AdoDb.Stream對(duì)象來讀取文本文件
'參數(shù)：FileUrl文件相對(duì)路徑，F(xiàn)ileCharSet:文件編碼
Function ReadFromTextFile (FileUrl,FileCharSet)'函數(shù)
    dim str
    set stm=server.CreateObject("adodb.stream")
    stm.Type=2 '指定或返回的數(shù)據(jù)類型,
    stm.mode=3 '指定打開模式，現(xiàn)在為可以讀寫模式，類似于word的只讀或鎖定功能
    stm.charset=FileCharSet
    stm.open
    stm.loadfromfile server.MapPath(FileUrl)
    str=stm.readtext
    ReadFromTextFile=str
End Function
'-----------------------------------------------------------------------------
'函數(shù)名稱:WriteToTextFile
'作用:利用AdoDb.Stream對(duì)象來寫入文本文件
sub WriteToTextFile(FileUrl,Str,FileCharSet) '方法
    set stm=server.CreateObject("adodb.stream")
    stm.Type=2 
    stm.mode=3
    stm.charset=FileCharSet
    stm.open
    stm.WriteText str
    stm.SaveToFile server.MapPath(FileUrl),2 
    stm.flush
End sub
'-----------------------------------------------------------------------------
'功能：自動(dòng)創(chuàng)建文件夾
'創(chuàng)建一級(jí)或多級(jí)目錄，可以創(chuàng)建不存在的根目錄
'參數(shù)：要?jiǎng)?chuàng)建的目錄名稱，可以是多級(jí)
'返回邏輯值，True成功，F(xiàn)alse失敗
'創(chuàng)建目錄的根目錄從當(dāng)前目錄開始
Function CreateMultiFolder(ByVal CFolder)
Dim objFSO,PhCreateFolder,CreateFolderArray,CreateFolder
Dim i,ii,CreateFolderSub,PhCreateFolderSub,BlInfo
BlInfo = False
CreateFolder = CFolder
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Err Then
Err.Clear()
Exit Function
End If
CreateFolder = Replace(CreateFolder,"","/")
If Left(CreateFolder,1)="/" Then
CreateFolder = Right(CreateFolder,Len(CreateFolder)-1)
End If
If Right(CreateFolder,1)="/" Then
CreateFolder = Left(CreateFolder,Len(CreateFolder)-1)
End If
CreateFolderArray = Split(CreateFolder,"/")
For i = 0 to UBound(CreateFolderArray)
CreateFolderSub = ""
For ii = 0 to i
CreateFolderSub = CreateFolderSub  CreateFolderArray(ii)  "/"
Next
PhCreateFolderSub = Server.MapPath(CreateFolderSub)
If Not objFSO.FolderExists(PhCreateFolderSub) Then
objFSO.CreateFolder(PhCreateFolderSub)
End If
Next
If Err Then
Err.Clear()
Else
BlInfo = True
End If
CreateMultiFolder = BlInfo
End Function
'點(diǎn)擊下載提示
function downloadFile(strFile)
     strFilename = server.MapPath(strFile)
     Response.Buffer = True
     Response.Clear
     Set s = Server.CreateObject("ADODB.Stream")
     s.Open
     s.Type = 1
     on error resume next
     Set fso = Server.CreateObject("Scripting.FileSystemObject")
     if not fso.FileExists(strFilename) then
         Response.Write("h1>Error:/h1>"  strFilename  " does not existp>")
         Response.End
     end if
     Set f = fso.GetFile(strFilename)
     intFilelength = f.size
     s.LoadFromFile(strFilename)
     if err then
         Response.Write("h1>Error: /h1>"  err.Description  "p>")
         Response.End
     end if
     Response.AddHeader "Content-Disposition", "attachment; filename="  f.name
     Response.AddHeader "Content-Length", intFilelength
     Response.CharSet = "UTF-8"
     Response.ContentType = "application/octet-stream"
     Response.BinaryWrite s.Read
     Response.Flush
     s.Close
     Set s = Nothing
End Function
'-----------------------------------------------------------------------------
If Err Then
    err.Clear
    Set conn = Nothing
    Response.Write "div style='font-size:12px;color:#333;height:20px;line-height:20px;border:1px solid #DDCF8F;padding:6px;background:#FFFFED;font-family:verdana'>網(wǎng)站異常出錯(cuò)，請(qǐng)與管理員聯(lián)系，謝謝！/div>"
    Response.End
End If
%>

%
'創(chuàng)建文件
dim templateName,templatechar,filepath,filename,fileCharset,templateContent
   templateName="template/template_word.htm"        '模板名字，支持帶路徑，如"/moban/moban1.htm"或"temp/moban1.htm"
   templatechar="gb2312"                      '模板文本的編碼
   filepath="files/word/"                     '生成文件保存的路徑，當(dāng)前目錄請(qǐng)留空，其他目錄，路徑必須以“/”結(jié)尾
   filename="Doc1.doc"                           '即將生成的文件名
   CreateMultiFolder(filepath)                '這一句用來判斷文件夾是否存在，沒有則自動(dòng)創(chuàng)建，支持n級(jí)目錄
   fileCharset="gb2312"                       '打算生成的文本編碼
'讀取指定的模板內(nèi)容
templateContent=ReadFromTextFile(templateName,templatechar)   
'以下就交給你來替換模板內(nèi)容了
templateContent=replace(templateContent,"{$websiteName}","藍(lán)色理想")
templateContent=replace(templateContent,"{$userName}","幸福的子彈")
templateContent=replace(templateContent,"{$now}",Now())
'其他內(nèi)容......
'最終調(diào)用函數(shù)來生成文件         
Call WriteToTextFile(filepathfilename,templateContent,fileCharset)   
'最后關(guān)閉adodb.stream對(duì)象
stm.flush
stm.Close
set stm=nothing
downloadFile(filepathfilename)
%>