复制代码 代码如下:
<%
Dim Cmd
Set Cmd = New Cls_Command
Class Cls_Command
Private Re
Public Function IsPositiveInteger(value)
Set Re = New RegExp
Re.Pattern = "^[1-9][\d]*$"
Re.IgnoreCase = True
Re.Global = True
IsPositiveInteger = Re.Test(value)
Set Re = Nothing
End Function
Public Function IsDigit(vString)
If vString = "" Then IsDigit = False : Exit Function
Set Re = New RegExp
Re.Pattern = "^[a-z]+$"
Re.Global = True
Re.IgnoreCase = True
Re.MultiLine = True
IsDigit = Re.Test(vString)
Set Re = Nothing
End Function
Public Function IsAlpha(vString)
If vString = "" Then IsAlpha = False : Exit Function
Set Re = New RegExp
Re.Pattern = "^[\d]+$"
Re.Global = True
Re.IgnoreCase = True
Re.MultiLine = True
IsAlpha = Re.Test(vString)
Set Re = Nothing
End Function
Public Function IsAlphaDigit(vString)
If vString = "" Then IsAlphaDigit = False : Exit Function
Set Re = New RegExp
Re.Pattern = "^[a-zA-Z\d]+$"
Re.Global = True
Re.IgnoreCase = True
Re.MultiLine = True
IsAlphaDigit = Re.Test(vString)
Set Re = Nothing
End Function
Dim TemplateContent,TemplateDeBug
Public Sub LoadTemplate(TemplateName)
On Error Resume Next
Dim TemplateObject,TemplateFile
Set TemplateObject=Server.CreateObject("Scripting.FileSystemObject")
Set TemplateFile=TemplateObject.OpenTextFile(Server.MapPath(TemplateName))
If Err.Number <> 0 Then
Err.Clear
Set TemplateFile=Nothing
Set TemplateObject=Nothing
TemplateDeBug=1
End If
TemplateContent=TemplateFile.ReadAll
TemplateFile.Close
Set TemplateFile=Nothing
Set TemplateObject=Nothing
End Sub
Dim HtmlContent,CreatDeBug
Public Sub BuildFile(Catalogue, HtmlName)
On Error Resume Next
If Not CheckFolder(Catalogue) Then
CreatDeBug=1
Exit Sub
End If
Dim CreatObject,CreatFile
Set CreatObject=Server.CreateObject("Scripting.FileSystemObject")
Set CreatFile=CreatObject.CreateTextFile(Server.MapPath(Catalogue & HtmlName),True,False)
If Err.Number <> 0 Then
Set CreatFile=Nothing
Set CreatObject=Nothing
Err.Clear
CreatDeBug=1
Exit Sub
End If
CreatFile.Write(HtmlContent)
CreatFile.Close
Set CreatFile=Nothing
Set CreatObject=Nothing
End Sub
Private Function CheckFolder(byval LocalPath)
On Error Resume Next
Dim FileObject
Dim patharr,path_level,pathtmp,cpath
LocalPath = Replace(LocalPath,"\","/")
Set FileObject=Server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath,"/")
path_level = Ubound(patharr)
Dim i
For i = 0 to path_level
If i = 0 Then
pathtmp = patharr(0) & "/"
Else
pathtmp = pathtmp & patharr(i) & "/"
End If
cpath = Left(pathtmp,Len(pathtmp)-1)
If Not FileObject.FolderExists(Server.MapPath(cpath)) Then FileObject.CreateFolder(Server.MapPath(cpath))
Next
Set FileObject=Nothing
If Err.Number<>0 then
Err.Clear
CheckFolder = False
Else
CheckFolder = True
End If
End Function
Public Function WriteCache(appName, Value)
Application.Lock
Application(appName) = Value
Application.Unlock
End Function
Public Function ClearCache(appName)
Application.Lock
Application.Contents.Remove(appName)
Application.UnLock
End Function
Public Sub OutputJavaInfo(Message)
Response.Expires = 0
Response.ExpiresAbsolute = Now() - 1
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "no-cache"
Response.ContentType = "application/x-javascript"
Response.Write "document.getElementById(""updateinfo"").innerHTML = """ & Message & """;"
Response.End
End Sub
Public Sub OutputinterHtml(Message, ShowType)
Response.Write Message
If ShowType = 1 Then
Response.Flush
Else
Response.End
End If
End Sub
End Class
%>