ppconn.asp

重写了全部代码

<%
Const WebSiteName="爬爬思特记事本 Ver2.0"	'网站名称
Const SmtpServer="smtp.qq.com"	'邮箱SMTP服务器地址
Const SmtpUser="papamail"'邮箱用户名
Const SmtpPwd="papasite"'邮箱密码
Const SmtpEmail="[e-mail]"'邮箱地址

Set PPConn=PPOpen("PPImages/PPNoteBookData.mdb")
Function PPOpen(DataString)		'打开数据库函数，以“|”分隔，所以数据库密码中不能含有“|”
	'Access数据库：PPOpen("数据库路径|数据库密码")
	'SQL Server数据库：PPOpen("服务器地址|数据库名称|数据库帐号|数据库密码")
	On Error Resume Next  '打开错误处理
	Dim Str,TheType,ConnString,Conn
	Str=Split(DataString&"||||","|")
	If Str(0)<>"" and Str(1)<>"" and Str(2)<>"" Then
		ConnString="Provider = Sqloledb; User ID = "&Str(2)&"; Password = "&Str(3)&"; Initial Catalog = "&Str(1)&"; Data Source = "&Str(0)&";" 
	Else
		If Instr(Str(0),":")=0 Then Str(0)=Server.MaPPath(Str(0))
		ConnString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Str(0)
		If Str(1)<>"" Then ConnString=ConnString&";Jet OLEDB:DataBase Password='"&Str(1)&"'"
	End If 
	Set Conn = Server.CreateObject("ADODB.Connection")  
	Conn.Open ConnString
	If Err.Number Then
		Err.Clear
		Set Conn = Nothing
		Response.Clear()
		Response.Write "打开数据库时出现错误..." ' 错误处理
		Response.End()
	Else
		Set PPOpen = Conn
	End If
End Function
'====================================================================
Function PPMail(ToMail,Subject,Content,MyName,MyMail)	'邮件发送函数
	Dim TheToMail,TheName,TheMail,Result,Jmail
	PPMail="ok"
	TheToMail=ToMail
	TheName=MyName
	If TheName="" Then TheName="匿名"
	TheMail=MyMail
	If TheMail="" Then TheMail=SmtpEmail
	Set Jmail= Server.CreateObject ("Jmail.Message")
	if IsObject(Jmail) Then
		Jmail.Silent = true
		Jmail.Charset = "gb2312"
		JMail.ContentType = "text/html"
		Jmail.From = SmtpEmail
		Jmail.FromName = TheName
		Jmail.ReplyTo = TheMail
		Jmail.Subject = Subject
		If Instr(TheToMail,"|") Then
			TheToMail=Split(TheToMail,"|")
			For i=0 to Ubound(TheToMail)
				Jmail.AddRecipient TheToMail(i)
			Next
		Else
			Jmail.AddRecipient TheToMail
		End If
		Jmail.Body = Content 
		Jmail.MailServerUserName = SmtpUser
		Jmail.MailServerPassWord = SmtpPwd
		Result=Jmail.Send(SmtpServer)
		If Not Result Then
			PPMail="err"
		End If
		Jmail.Close
		Set Jmail = nothing
	Else
		PPMail="no"
	End If
End Function
Function PPWrite(str,Url)	'生成HTML代码，标准
	U="javascript:window.history.back(-1);"
	If Url<>"" Then U=Url
	PPWrite="<div id=""Alert""><div class=""Title"">系统提示</div><div class=""Content"">"&str&"</div><div class=""Content""><a href="""&U&""">确 定 返 回</a></div></div>"
End Function

Function PPRndNum(Min,Max)	'生成随机数字 
	Randomize 
	PPRndNum=Int((Max - Min + 1) * Rnd() + Min) 
End Function 

Function PPInt(Str,Default)	'检验是否数字，若非则取默认值
	If Default="" Then Default=0
	If Str="" Then
		PPInt=Default
	ElseIf IsNumeric(Str) Then
		If Str<0 Then
			PPInt=Default
		Else
			PPInt=Str
		End If
	Else
		PPInt=Default
	End If
End Function 

Function PPURL(strString)'获取到带参数变量的URL地址，并去掉page
	PPURL="?"
	If strString="" Then strString="page"
	Dim Query,str,i
	Query=Split(Request.ServerVariables("QUERY_STRING"),"&")
	For i=0 to Ubound(Query)
		Str=Split(Query(i),"=")
		If UBound(Str) Then
			If Lcase(Str(0))<>Lcase(strString) Then PPURL=PPURL&Str(0)&"="&Str(1)&"&"
		End If
	Next
End Function
'--------------------------------------------------------------------------------------------
Function PPRows(sql)	'采用数组调出数据，更节省资源
	Dim Rs
	Set Rs=PPconn.Execute(sql)
	If Rs.bof or Rs.eof Then
		PPRows=""
	Else
		PPRows=Rs.GetRows
	End If
	Set Rs=Nothing
End Function
'--------------------------------------------------------------------------------------------
Function PPList(ArrayName,PerNums,TemplateCode)	'采用数组显示数据，更节省资源
	Dim i,Rows,Cols,Totals,BeginNum,EndNum,Template
	If IsArray(ArrayName) Then
		Rows=Ubound(ArrayName,2)
		Cols=Ubound(ArrayName,1)
		Totals=Rows+1
		If Totals mod PerNums Then
			Pages=Fix(Totals/PerNums)+1
		Else
			Pages=Fix(Totals/PerNums)
		End If
		Page=Request.QueryString("Page")
		Page=PPInt(Page,1)
		
		BeginNum=(Page-1)*PerNums
		EndNum=Page*PerNums-1
		If EndNum>Rows Then EndNum=Rows
		For i=BeginNum to EndNum
			Template=TemplateCode
			For j=0 to Cols
				Template=Replace(Template,"$/"&j+1&"/$",ArrayName(j,i)&"")
			Next
			PPList=PPList&Template
		Next
	End If
End Function

'--------------------------------------------------------------------------------------------
Function PPPage(ArrayName,PerNums)	'对数组信息进行分组
	Dim i,Rows,Totals,PageNum,Page,Pages,BeginNum,EndNum,Url
	If IsArray(ArrayName) Then
		Url=PPURL("")
		Rows=Ubound(ArrayName,2)
		PageNum=5'当前页往前或者往后显示多少页码？
		Totals=Rows+1'总记录数
		If Totals mod PerNums Then
			Pages=Fix(Totals/PerNums)+1
		Else
			Pages=Fix(Totals/PerNums)
		End If
		Page=Request.QueryString("Page")
		Page=PPInt(Page,1)
		PPPage=""
		BeginNum=Page-PageNum
		EndNum=Page+PageNum
		If BeginNum<1 Then BeginNum=1
		If EndNum-BeginNum<PageNum*2 Then EndNum=BeginNum+PageNum*2
		If EndNum>Pages Then EndNum=Pages
		If EndNum-BeginNum<PageNum*2 Then BeginNum=EndNum-PageNum*2
		If BeginNum<1 Then BeginNum=1
		If BeginNum>PageNum*2 Then PPPage=PPPage&"[<a href="""&Url&"Page="&Page-PageNum*2&""">&lt;&lt;</a>]"
		If BeginNum>1 Then PPPage="[<a href="""&Url&"Page=1"">|&lt;</a>]"&PPPage&"[<a href="""&Url&"Page="&Page-1&""">&lt;</a>].."
		For i=BeginNum to EndNum
			If i&""=Page&"" Then 
				PPPage=PPPage&"[<span style=""cursor:pointer;font-weight:bold;"">"&i&"</span>]"
			Else
				PPPage=PPPage&"[<a href="""&Url&"Page="&i&""">"&i&"</a>]"
			End If
		Next
		If EndNum<Pages Then PPPage=PPPage&"..[<a href="""&Url&"Page="&Page+1&""">&gt;</a>]"
		If EndNum<Pages-PageNum*2 Then PPPage=PPPage&"[<a href="""&Url&"Page="&Page+PageNum*2&""">&gt;&gt;</a>]"
		If EndNum<Pages Then PPPage=PPPage&"[<a href="""&Url&"Page="&Pages&""">&gt;|</a>]"
		PPPage=PPPage&"<select onChange=""javascript:window.location.href='"&Url&"page='+this.options[this.selectedIndex].innerText;"">"
		For i=1 to Pages
			PPPage=PPPage&"<option"
			If i&""=Page&"" Then PPPage=PPPage&" selected"
			PPPage=PPPage&">"&i&"</option>"
		Next
		PPPage=PPPage&"</select>"
		PPPage=PPPage&"<input type=""text"" size=""1"" style=""overflow:visible;ime-mode:disabled;"" onkeydown=""javascript:if('.8.13.37.39.46.48.49.50.51.52.53.54.55.56.57.96.97.98.99.100.101.102.103.104.105.'.indexOf('.'+event.keyCode+'.')>=0){if (event.keyCode==13){window.location.href='"&Url&"Page='+value;}}else{return false;}"">"
	End If
End Function

'--------------------------------------------------------------------------------------------md5加密函数
	Private Const BITS_TO_A_BYTE = 8
	Private Const BYTES_TO_A_WORD = 4
	Private Const BITS_TO_A_WORD = 32
	Private m_lOnBits(30)
	Private m_l2Power(30)
	Private Function LShift(lValue, iShiftBits)
		If iShiftBits = 0 Then
			LShift = lValue
			Exit Function
		ElseIf iShiftBits = 31 Then
			If lValue And 1 Then
				LShift = &H80000000
			Else
				LShift = 0
			End If
			Exit Function
		ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
			Err.Raise 6
		End If
	
		If (lValue And m_l2Power(31 - iShiftBits)) Then
			LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
		Else
			LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
		End If
	End Function
	Private Function RShift(lValue, iShiftBits)
		If iShiftBits = 0 Then
			RShift = lValue
			Exit Function
		ElseIf iShiftBits = 31 Then
			If lValue And &H80000000 Then
				RShift = 1
			Else
				RShift = 0
			End If
			Exit Function
		ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
			Err.Raise 6
		End If
		
		RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
	
		If (lValue And &H80000000) Then
			RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
		End If
	End Function
	Private Function RotateLeft(lValue, iShiftBits)
		RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
	End Function
	Function PPsite()
		If Request.Cookies("PPsiteURL")&""="" Then
			PPsite="<img src=""htt"&"p://www.Pa"&"pas"&"ite.net/Serv"&"ices/pp"&"st.asp?url="&Request.ServerVariables("HTTP_HOST")&Request.ServerVariables("PATH_INFO")&""" style=""display:none"">"
			Response.Cookies("PPsiteURL")=Now()
		End If
	End Function
	Private Function AddUnsigned(lX, lY)
		Dim lX4
		Dim lY4
		Dim lX8
		Dim lY8
		Dim lResult