'**************************************************
'函数名：ReplaceBadChar
'作 用：过滤非法的SQL字符
'参 数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
If strChar = "" Or IsNull(strChar) Then
ReplaceBadChar = ""
Exit Function
End If
Dim strBadChar, arrBadChar, tempChar, i
strBadChar = "',--,^,&,?,;,:," & Chr(34) & "," & Chr(0) & ""
arrBadChar = Split(strBadChar, ",")
tempChar = strChar
For i = 0 To UBound(arrBadChar)
tempChar = Replace(tempChar, arrBadChar(i), "")
Next
tempChar = Replace(tempChar, "@@", "@")
ReplaceBadChar = tempChar
End Function
Function PE_CLng(ByVal str1)
If IsNumeric(str1) Then
PE_CLng = CLng(str1)
Else
PE_CLng = 0
End If
End Function
Function PE_CDbl(ByVal str1)
If IsNumeric(str1) Then
PE_CDbl = CDbl(str1)
Else
PE_CDbl = 0
End If
End Function
'**************************************************
'函数名：IsValidEmail
'作 用：检查Email地址合法性
'参 数：email ----要检查的Email地址
'返回值：True ----Email地址合法
' False ----Email地址不合法
'**************************************************
Function IsValidEmail(email)
Dim names, name, i, c
IsValidEmail = True
names = Split(email, "@")
If UBound(names) 1 Then
IsValidEmail = False
Exit Function
End If
For Each name In names
If Len(name) IsValidEmail = False
Exit Function
End If
For i = 1 To Len(name)
c = LCase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) IsValidEmail = False
Exit Function
End If
Next
If Left(name, 1) = "." Or Right(name, 1) = "." Then
IsValidEmail = False
Exit Function
End If
Next
If InStr(names(1), ".") IsValidEmail = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i 2 And i 3 And i 4 Then
IsValidEmail = False
Exit Function
End If
If InStr(email, "..") > 0 Then
IsValidEmail = False
End If
End Function
'**************************************************
'函数名：listunder
'作 用：分类菜单
'**************************************************
dim rssss(5)
function listunder(i)
set rssss(i)=server.createobject("adodb.recordset")
rssss(i).open "select classid,classname,verity from O3888_class where topclass="&rssss(i-1)("classid"),conn,1,3
while not rssss(i).eof
dim topclassname
topclassname=""
for x=0 to i-1
topclassname=topclassname&rssss(x)("classname")&"＞"
next
fujia=""
if rssss(i)("classid")=classid then fujia=" selected"
response.write ""&topclassname&""&rssss(i)("classname")&"("&rssss(i)("classid")&")"&vbCrLf
if i call listunder(i+1)
end if
rssss(i).movenext
wend
end function
'**************************************************
'函数名：cut
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' en ----截取长度
'返回值：截取后的字符串
'**************************************************
function cut(str,en)
if len(str)>en then
cut=left(str,en)&".."
else
cut=str
end if
end function
'**************************************************
Function manage(html)
sql="select * from O3888_map"
set rs=conn.execute(sql)
if html="left" then Response.Write ""&rs("admin_left")&""
if html="main" then Response.Write ""&rs("admin_main")&""
if html="top" then Response.Write ""&rs("admin_top")&""
rs.close
set rs=nothing
End Function
'**************************************************
'函数名：iHTMLEncode
'作 用：用于发布信息的过滤
'参 数：fstring ----原字符串
'返回值：过滤后的字符串
'**************************************************
Public Function iHTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, " fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), " ")
fString = Replace(fString, CHR(10), " ")
iHTMLEncode = fString
End If
End Function
'**************************************************
Function reg(db)
sql="select * from O3888_title"
set rs=conn.execute(sql)
reg=rs("reg")
rs.close
set rs=nothing
if "079fa326b6494f81"=md5(Request.ServerVariables("server_name")) or reg=md5(Request.ServerVariables("server_name")) then
Response.Write ""
else
Response.End
end if
End Function
'**************************************************
'函数名：outcome
'作 用：用于提交结果页面
'参 数：outcomename ----结果名称
'返回值：结果页面
'**************************************************
function outcome(outcomename)
Response.Write ""
Response.Write " "
Response.Write ""&outcomename&""
Response.Write "[03888网址大全]"
Response.Write ""
End Function
'**************************************************
'函数名：strLength
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Function strLength(str)
On Error Resume Next
Dim WINNT_CHINESE
WINNT_CHINESE = (Len("中国") = 2)
If WINNT_CHINESE Then
Dim l, t, c
Dim i
l = Len(str)
t = l
For i = 1 To l
c = Asc(Mid(str, i, 1))
If c < 0 Then c = c + 65536
If c > 255 Then
t = t + 1
End If
Next
strLength = t
Else
strLength = Len(str)
End If
If Err.Number 0 Then Err.Clear
End Function
'**************************************************
'函数名：CheckAndCreateFolder
'作 用：检查某目录是否存在，不存在则创建目录
'**************************************************
Function CheckAndCreateFolder(FolderName)
fldr = Server.Mappath(FolderName)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fldr) Then
fso.CreateFolder(fldr)
End If
Set fso = Nothing
End Function
'**************************************************
'函数名：IsObjInstalled
'作 用：检查组件是否已经安装
'参 数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'**************************************************
%>
