黑色海岸线论坛 - Powered by Discuz! Board

<%
dim conn
dim connstr
dim connType,dbPath
connType=1
Set conn= Server.CreateObject("ADODB.Connection")
IF conn.State = 0 Then
IF connType= 1 Then
connstr = "Provider=SQLOLEDB;uid=shadow;pwd=XXXXXX;Initial Catalog=XXXXXX;server=(local);"
Else
dbPath = Server.Mappath("\") & "\hkcn\database\webhkcn.mdb"
connstr = "Provider=Microsoft.JET.OLEDB.4.0;Data Source="& dbPath &";"
End If
conn.Open connstr
End If
Function SQLExecute(SqlStr)
on error resume next
Dim Rs
Set Rs=Server.CreateObject("Adodb.Recordset")
Rs.open SqlStr,conn,1,3
Set SQLExecute=Rs
If Err.Number <> 0 Then
Response.Write("抱歉你在访问本页时出现一个错误以下是错误的详细信息。 ")
Response.Write("错误号:"&CStr(Hex(Err.Number))&" ")
Response.Write("错误对象:"&Err.Source&" ")
Response.Write("有关错误的详细描述:"&Err.Description&" ")
Response.Write("如果你始终无法访问本页请联系管理员。")
End If
End Function
';=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
%>
<%
';=================================================
'; Public Function
'; Programmer by Jiang Jian(Shadow)
'; Email:vbcc@sohu.com
'; Date: 2003-05-26
';=================================================
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';判断用户是否登录
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function ChkLogin(UserName,Pass)
Dim Sql,Rs
Sql="Select id,username,password FROM member WHERE username=';"&UserName&"'; And password=';"&Pass&"';"
Set Rs=SQLExecute(Sql)
If Not (Rs.bof or Rs.eof) Then
ChkLogin=Rs("ID")
Else
ChkLogin=False
End If
Rs.Close
Set Rs=Nothing
End Function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';判断是否非法提交数据 True 为正常 False 为非法提交
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function ChkPost()
Dim server_v1,server_v2
Chkpost=False
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1,8,Len(server_v2))<>server_v2 Then
Chkpost=False
Else
Chkpost=True
End if
End function
';====================================================
';判断用户名是否包含非法字符 True 合法的字符串
';====================================================
Function CheckString(Str1)
Dim N
Dim S
For N = 1 To Len(Str1)
S = Asc(Mid(Str1, N))
If S > 47 And S < 58 Or S > 64 And S < 91 Or S > 96 And S < 122 Or S = 95 Then ';合法的字符串
CheckString=True
Else
CheckString=False
End If
Next
End Function
';====================================================
';判断字符是否为中文 True 合法 False 非法
';====================================================
Function IsChinese(Str)
Dim N
Dim S
For N = 1 To Len(Str)
S = Asc(Mid(Str, N))
If S => 0 Then
IsChinese=False
Exit for
Else
IsChinese=True
End If
Next
End Function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';判断是否为合法的电话号码 True 合法 False 非法
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function IsPhone(Str)
Dim strArray
IsPhone=False
strArray=Split(Str,"-",-1,1)
IF Ubound(strArray)> 0 Then
IF Len(strArray(0))>2 And Len(strArray(0))< 5 Then
IF Len(strArray(1))>6 And Len(strArray(1))< 9 Then
If IsNumeric(strArray(0))=True And IsNumeric(strArray(1)) Then
IsPhone=True
End If
End If
End If
End IF
End Function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';判断是否为合法的电子邮件地址 True 合法 False 非法
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
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) <= 0 Then
IsValidEmail = False
Exit Function
End If
For i = 1 To Len(name)
c = Lcase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
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), ".") <= 0 Then
IsValidEmail = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
IsValidEmail = False
Exit Function
End If
If InStr(Email, "..") > 0 Then
IsValidEmail = False
End If
End function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';数据分页显示 strUrl 设置成自己本页
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function PageSplit(objRs,strUrl,cssClass,listSize,cssSep)
Dim pgnum,page
page=Request("page")
objRs.PageSize = listSize
pgnum=objRs.Pagecount
if page="" or clng(page)<1 then page=1
if clng(page) > pgnum then page=pgnum
if pgnum>0 then objRs.AbsolutePage=page
If page=1 Then
Response.Write " 首页 | 上一页 | "
Else
Response.Write " <a class="& cssClass &" href="&strUrl&"page=1>首页</a> | "
Response.Write "<a class="& cssClass &" href="&strUrl&"page="&page-1&"> 上一页</a> | "
End if
If objRs.pagecount-page<1 Then
Response.Write "下一页 | 尾页"
Else
Response.Write "<a class="& cssClass &" href="&strUrl&"page="&page+1&">下一页</a> | "
Response.Write "<a class="& cssClass &" href="&strUrl&"page="&objRs.pagecount&">尾页</a>"
End if
Response.Write "　　　　　　　　　　　　　　第 "&page&" 页/共 "&pgnum&" 页"
End Function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';文章分页显示 strUrl 设置成自己本页
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function SplitPage(strContents)
Dim Page,PageArray
PageArray=SepPosition(strContents)
Page=Request("page")
pgnum=UBound(PageArray)
IF page="" or clng(page)<0 Then page=0
IF Clng(page) > pgnum Then page=pgnum
IF pgnum = 0 Then ';只有一页
SplitPage=strContents
Exit Function
End IF
If Page = 0 Then
SplitPage=Mid(strContents,1,PageArray(page)-1)
ElseIf Clng(Page)=pgnum Then
SplitPage=Mid(strContents,PageArray(page-1)+19,Len(strContents))
Else
SplitPage=Mid(strContents,PageArray(page-1)+19,PageArray(page)-(PageArray(page-1)+19))
End if
End Function
Public Function NavPage(strPage)
Page=Request("page")
IF page="" or clng(page)<0 Then page=0
IF pgnum > 0 Then
IF Page = 0 Then
Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page & """>上一页</a> "
Else
Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page - 1 & """>上一页</a> "
End if
If pgnum-Clng(Page)<1 Then
Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page &""">下一页</a> "
Else
Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page + 1 & """>下一页</a>"
End If
Response.Write " 共 " & pgnum + 1 & " 页当前第 " & page + 1 & " 页"
End IF
End Function
Public Function SepPosition(strContents)
Dim intPos,strPos
Dim intPageArray,strTemp
strTemp = "[PAGE]------[/PAGE]"
intPos=Instr(strContents,strTemp)
strPos = intPos
Do While (intPos)
intPos=Instr(intPos+19,strContents,strTemp)
strPos=strPos & "," & intPos
Loop
SepPosition=Split(strPos,",")
End Function
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
';截取一定数量的文字输出
';>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function OutText(strText,intOutSize)
IF Len(strText)>intOutSize Then
OutText = Left(strText,intOutSize-3) & "..."
Else
OutText = strText
End If
End Function
%>

复制代码