ASP生成HTML静态文件之组件封装

一、引用

Microsoft Active Server Pages Object Library
Microsoft ActiveX Data Objects 2.7 Library
COM+ Services Type Library
Microsft Scripting Runtime

二、设置

工程名：mmAsp
类模块：doHtml

三、代码

Private mmOSM, mmFSO
Private mmVarArr, mmValArr
Private mmCharset '编码GB2312或UTF-8
Private mmTplPath '模板文件的绝对路径
Private mmHtmPath '生成HTML文件的绝对路径
Private strHtml, i

Private Response As Response
Private Request As Request
Private Server As Server
Private Application As Application
Private Session As Session
Private objContext As ObjectContext

Private Sub Class_Initialize()
On Error Resume Next
Set objContext = GetObjectContext()
Set Response = objContext("Response")
Set Request = objContext("Request")
Set Server = objContext("Server")
Set Application = objContext("Application")
Set Session = objContext("Session")
'================================================================================
Set mmOSM = New ADODB.Stream
If Err.Number = -2147221005 Then
Response.Write "非常遗憾，您的主机不支持ADODB.Stream，不能使用本程序"
Err.Clear
Response.End
End If
Set mmFSO = New FileSystemObject
If Err.Number <> 0 Then
'Err.Number值 429-组件未注册 48-没有权限
Response.Write "您的空间不支持FSO，或者没有相关权限，不能使用本程序。"
Err.Clear
Response.End
End If
mmCharset = "GB2312" '默认采用GB2312编码[值为UTF-8或GB2312]
End Sub

Private Sub Class_Terminate()
Set mmOSM = Nothing: mmOSM = Null
Set mmFSO = Nothing: mmFSO = Null
Set ojbSContext = Nothing
Set Response = Nothing
Set Request = Nothing
Set Server = Nothing
Set Application = Nothing
Set Session = Nothing
End Sub

'版本信息
Public Property Get Version()
Version = "HTML静态文件操作类v1.0"
End Property

'================================================================
'Charset  获取文件编码 UTF-8 或 GB2312
'================================================================
Public Property Let Charset(ByVal TmpCharset)
mmCharset = TmpCharset
End Property
'================================================================
'TplPath  获取模板文件所在的绝对路径
'================================================================
Public Property Let TplPath(ByVal TmpTplPath)
mmTplPath = TmpTplPath
End Property
'================================================================
'HtmPath  获取生成HTML所在的绝对路径
'================================================================
Public Property Let HtmPath(ByVal TmpHtmPath)
mmHtmPath = TmpHtmPath
End Property
'================================================================
'VarArr  获取变量数组
'================================================================
Public Property Let VarArr(ByVal TmpVarArr)
mmVarArr = TmpVarArr
End Property
'================================================================
'ValueArr  获取字段对应的值数组
'================================================================
Public Property Let ValArr(ByVal TmpValArr)
mmValArr = TmpValArr
End Property
'================================================================
'生成HTML文件
'================================================================
Public Sub toHtml()
CreateFolder '创建目录
strHtml = LoadHTemplate
For i = 0 To UBound(mmVarArr)
strHtml = Replace(strHtml, mmVarArr(i), mmValArr(i))
Next
On Error Resume Next
With mmOSM
.Type = 2
.Mode = 3
.Charset = mmCharset
.Open
.WriteText strHtml
.SaveToFile mmHtmPath, 2
.Flush
.Close
End With
If Err.Number <> 0 Then
Response.Write "写入文件失败!"
Err.Clear
Response.End
End If
End Sub
'**********************************************
'目的：  载入HTML模板
'返回：  HTML模板内容
'**********************************************
Private Function LoadHTemplate()
On Error Resume Next
With mmOSM
.Type = 2
.Mode = 3
.Open
.LoadFromFile mmTplPath
If Err.Number <> 0 Then
Response.Write "模板文件" & mmTplPath & "无法被打开，请检查文件是否存在!"
Err.Clear
Response.End
End If
.Charset = mmCharset
.Position = 2
LoadHTemplate = .ReadText '返回读取的内容
.Close
End With
End Function
'================================================================
'CreateFolder 递归创建目录函数
'================================================================
Private Sub CreateFolder()
On Error Resume Next
Dim mmPathArr, mmCursor
mmPathArr = Split(mmHtmPath, "\")
For i = 0 To UBound(mmPathArr) - 1
mmCursor = mmCursor & mmPathArr(i) & "\"
If Not mmFSO.FolderExists(mmCursor) Then
mmFSO.CreateFolder (mmCursor)
If Err.Number <> 0 Then
Response.Write "创建目录失败!"
Err.Clear
Response.End
End If
End If
Next
End Sub
'================================================================
'delFile  删除文件
'================================================================
Public Sub DelFile()
On Error Resume Next
mmFSO.DeleteFile Server.MapPath(mmHtmPath)
'Err.Number值 53-文件不存在 70-删除失败，可能是权限不够或文件只读
End Sub

四、生成DLL（略）

五、实例

1、模板文件

{$title}<br>
<hr>
发布时间：{$time} 文章来源：{$from}
<p>
{$content}

2、生成文件

<%
Dim ClsFSO
Set ClsFSO=Server.createobject("mmASP.doHtml")
With ClsFSO
.Charset="GB2312"'或UTF-8，可省略，省略默认编码为GB2312
.TplPath=Server.MapPath("/Template/news.txt")'模板文件,相对于网站根目录路径(以/开始)
.HtmPath=Server.MapPath("/html/news/file.htm")'准备生成的文件所在位置，相对于网站根目录路径(以/开始)
.VarArr=Array("{$title}","{$time}","{$from}","{$content}") '加载替换变量数组
.ValArr=Array("这是文章标题",now,"<a href='/'>www.asp163.com</a>","这里是文章内容")
.toHtml
End With
Set ClsFSO=Nothing:ClsFSO=NULL
%>生成文件成功。

3、删除文件

<%
'删除HTML文件
Dim ClsFSO
Set ClsFSO=Server.createobject("mmASP.doHtml")
With ClsFSO
.HtmPath=Server.MapPath("/html/news/file.htm")
.DelFile
End With
Set ClsFSO=Nothing:ClsFSO=NULL
%>删除文件成功。

六、结束