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
%>删除文件成功。

六、结束

提示：类或Dll，出错时后，显示出错信息，并执行Response.End后，仍会执行Class_Terminate()