COOKIES加一个SessionID
003
定义和用法
SessionID 属性为每个用户返回一个唯一的 id 。此 id 由服务器生成。
语法
Session.SessionID
实例
<%Response.Write(Session.SessionID)%>
输出了您的 SessionID :
279220931
SessionID
SessionID 属性返回用户的会话标识。在创建会话时,服务器会为每一个会话生成一个单独的标识。会话标识以长整形数据类型返回。
语法
Session.SessionID
注释
不要用 SessionID 属性为数据库应用程序创建主关键字。这是因为,如果 Web 服务器重新启动,则部分 SessionID 的值可能同服务器终止前产生的值相同。可以使用自动增加的列数据类型来代替,如 Microsoft® SQL Server 中的 IDENTITY,或 Microsoft® Access 中的 COUNTER 。
应用于
Session 对象
'函数名:ResponseCookies
'作 用:写入COOKIES
'参 数:Key ----cookie名
' value ----cookie值
' expires ---- cookie过期时间
'****************************************************
Public Function ResponseCookies(Key,Value,Expires)
DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))
Response.Cookies(Key)=""&Value&""
if Expires<>0 then Response.Cookies(Key).Expires=date+Expires
Response.Cookies(Key).Path=DomainPath
End Function
'****************************************************
'函数名:CleanCookies
'作 用:清除COOKIES
'****************************************************
Public Function CleanCookies()
DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))
For Each objCookie In Request.Cookies
Response.Cookies(objCookie)= ""
Response.Cookies(objCookie).Path=DomainPath
Next
End Function
'****************************************************
'函数名:GetTimeOver
'作 用:清除COOKIES
'参 数:flag ---显示时间单位1=秒,否则毫秒
'****************************************************
Public Function GetTimeOver(flag)
Dim EndTime
If flag = 1 Then
EndTime=FormatNumber(Timer() - StartTime, 6, true)
getTimeOver = " 本页执行时间: " & EndTime & " 秒"
Else
EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
getTimeOver =" 本页执行时间: " & EndTime & " 毫秒"
End If
End function
函数ID:0046[Cookie防乱码写入时用]
'函数名:CodeCookie
'作 用:Cookie防乱码写入时用
'参 数:str ---- 字符串
'返回值:整理后的字符串
'示 例:
'**************************************************
Public Function CodeCookie(str)
If isNumeric(str) Then str=Cstr(str)
Dim newstr
newstr=""
For i=1 To Len(str)
newstr=newstr & ascw(mid(str,i,1))
If i<> Len(str) Then newstr= newstr & "a"
Next
CodeCookie=newstr
End Function
'**************************************************
'函数ID:0047[Cookie防乱码读出时用]
'函数名:DecodeCookie
'作 用:Cookie防乱码读出时用
'参 数:str ---- 字符串
'返回值:整理后的字符串
'示 例:
'**************************************************
Public Function DecodeCookie(str)
DecodeCookie=""
Dim newstr
newstr=Split(str,"a")
For i = LBound(newstr) To UBound(newstr)
DecodeCookie= DecodeCookie & chrw(newstr(i))
Next
End Function
'**************************************************
'函数ID:0048[检测用户名和密码是否正确]
'函数名:DecodeCookie
'作 用:检测用户名和密码是否正确
'参 数:ConnStrs ---- 数据库链接字串
'参 数:Tabnamestr ---- 数据表名称
'参 数:Tumc ---- 用户名称字段名称
'参 数:Cumc ---- 用户名称
'参 数:TCumm ---- 用户密码字段名称
'参 数:Cumm ---- 用户密码
'参 数:TUid ---- 用户ID(标识)字段名称
'返回值:检测成功返回 用户ID 否则 空字符串
'示 例:
'**************************************************
Public Function CKUSMCMM(ByVal ConnStrs,ByVal Tabnamestr,ByVal Tumc,ByVal Cumc,ByVal Tumm,ByVal Cumm,ByVal TUid)
CKUSMCMM=""
On Error GoTo 0
On Error Resume Next
Set sfu_Conn=server.createobject("ADODB.Connection")
Set sfu_Rs =server.createobject("ADODB.Recordset")
sfu_Conn.open ConnStrs
sfu_sql_str="select " & TUid & "," & Tumc & "," & Tumm & " from " & Tabnamestr
sfu_Rs.open sfu_sql_str,sfu_Conn,1,1
If sfu_Rs.RecordCount >0 Then
Do While Not sfu_Rs.Eof
If (sfu_Rs(Tumc)=Cumc) AND (exmw(sfu_Rs(Tumm))=Cumm) Then
CKUSMCMM=sfu_Rs(TUid)
Exit Do
End If
sfu_Rs.MoveNext
Loop
End If
sfu_Rs.Close
sfu_Conn.Close
Set sfu_Rs = Nothing
Set sfu_Conn=Nothing
On Error GoTo 0
End Function
'**************************************************
'函数ID:0049[生成时间的整数]
'函数名:GetMyTimeNumber()
'作 用:生成时间的整数
'参 数:lx ---- 时间整数的类型
' lx=0 到分钟 lx=1 到小时 lx=2 到天 lx=3 到月
'返回值:生成时间的整数值(最小到分钟)
'示 例:
'**************************************************
Public Function GetMyTimeNumber(lx)
If lx=0 Then GetMyTimeNumber=Year(Date)*12*30*24*60+Month(Date)*30*24*60+Day(Date)*24*60+Hour(Time)*60+Minute(Time)
If lx=1 Then GetMyTimeNumber=Year(Date)*12*30*24+Month(Date)*30*24+Day(Date)*24+Hour(Time)
If lx=2 Then GetMyTimeNumber=Year(Date)*12*30+Month(Date)*30+Day(Date)
If lx=3 Then GetMyTimeNumber=Year(Date)*12+Month(Date)
End Function
'**************************************************
'函数ID:0043[解密字符加解密]
'函数名:exmw
'作 用:解密字符加解密
'参 数:nmw ---- 加密的字符
'返回值:解密加密后的字符
'示 例:
'**************************************************
Public Function exmw(ByVal nmw)
exmw=""
On Error GoTo 0
On Error Resume Next
Dim keya,keyb,newStr,temp
nmw=DecodeCookie(nmw)
keya=Mid(nmw,2,1)
keyb=Mid(nmw,1,1)
bLowChr=ChrB(AscB(MidB(keya, 1, 1)) Xor 128)
bHigChr=ChrB(AscB(MidB(keya, 2, 1)) Xor 18)
keya=bLowChr & bHigChr
bLowChr=ChrB(AscB(MidB(keyb, 1, 1)) Xor 100)
bHigChr=ChrB(AscB(MidB(keyb, 2, 1)) Xor 20)
keyb=bLowChr & bHigChr
Str=StrReverse(Mid(nmw,3,len(nmw)))
newStr=""
temp=""
For i=1 to len(Str)
temp=Mid(Str,i,1)
bLowChr=AscB(MidB(temp, 1, 1)) Xor asc(keya)
bHigChr=AscB(MidB(temp, 2, 1)) Xor asc(keyb)
newStr=newStr & ChrB(bLowChr) & ChrB(bHigChr)
Next
If Err.Number = 0 Then
exmw=newStr
End If
On Error GoTo 0
End Function
'**************************************************
'函数ID:0044[创建数据表]
'函数名:CreatTable
'作 用:创建数据表
'参 数:ConnStrs ---- 数据库链接字串
'参 数:Tabnamestr ---- 数据表名称
'参 数:CvArrstr ---- 字段表 (写法: Fname1#Type#Len#Defvalue|Fname1#Type#Len#Defvalue|...) 最后一个不要写“|”
'参 数:SqlType ---- Sql语句类型 (0 Access 1 Mssqlserver)
' Fname,Type,Len,Defvalue 说明:字段名称,字段类型,字段长度,默认值
'字段类型 Type C/c 字符 T/t 文本 I/i 二进制 D/d 日期 M/m 关键字(字符型) A/a 关键字自动编号(数值型) N/n 数值(float) Z/z 数值(int)
'返回值:如果建立成功返回 True 否则 False
'示 例:CreatTable(basicDB(3),"cs","fa#t##|fb#c#20#a|fc#n##5",0)
'**************************************************
Public Function CreatTable(ByVal ConnStrs,ByVal Tabnamestr,ByVal CvArrstr,ByVal SqlType)
CreatTable=False
On Error GoTo 0
On Error Resume Next
Dim filsarry,NeFilarry,Filstr,spfstr,templx,def_kh_l,def_kh_r,TempSqlStr
def_kh_l=""
def_kh_r=""
Filstr=""
spfstr=""
TempSqlStr=""
filsarry=Split(CvArrstr,"|")
For ai = LBound(filsarry) To UBound(filsarry)
NeFilarry=Split(filsarry(ai),"#")
templx=""
If UCase(NeFilarry(1))="C" Then templx="varchar(" & NeFilarry(2) & ")"
If UCase(NeFilarry(1))="T" Then templx="TEXT"
If UCase(NeFilarry(1))="I" Then templx="image"
If UCase(NeFilarry(1))="D" Then templx="datetime"
If UCase(NeFilarry(1))="M" Then templx="varchar(" & NeFilarry(2) & ") NOT NULL PRIMARY KEY"
If UCase(NeFilarry(1))="A" Then templx="Int IDENTITY (1,1) NOT NULL PRIMARY KEY"
If UCase(NeFilarry(1))="N" Then templx="Float"
If UCase(NeFilarry(1))="Z" Then templx="Int"
If SqlType =1 Then
def_kh_l="('"
def_kh_r="')"
End If
If Trim(NeFilarry(3))<>"" Then templx=templx &" DEFAULT " & def_kh_l & Trim(NeFilarry(3)) & def_kh_r
If ai<>UBound(filsarry) Then
spfstr= spfstr & "[" & NeFilarry(0) & "] " & templx &","
Else
spfstr= spfstr & "[" & NeFilarry(0) & "] " & templx
End If
Next
TempSqlStr="CREATE TABLE ["&Trim(Tabnamestr)&"] (" & spfstr & ")"
set fu_Conn=server.createobject("ADODB.Connection")
fu_Conn.open ConnStrs
fu_Conn.Execute TempSqlStr
fu_Conn.Close
Set fu_Conn=Nothing
If Err.Number = 0 Then
CreatTable=True
End If
On Error GoTo 0
End Function
'**************************************************
'函数ID:0045[在数据库中插入字段值]
'函数名:InterTbValue
'作 用:创建数据表
'参 数:ConnStrs ---- 数据库链接字串
'参 数:Tabnamestr ---- 数据表名称
'参 数:CvArrstr ---- 字段表 (写法: Fname1#Value|Fname2#Value|...) 最后一个不要写“|”
'参 数:SqlType ---- Sql语句类型 (0 Access 1 Mssqlserver)
' Fname,Value 说明:字段名称,字段值
'返回值:如果插入成功返回 True 否则 False
'示 例:InterTbValue(basicDB(3),"cs","fa#t|fb#c|fc#n#")
'**************************************************
Public Function InterTbValue(ByVal ConnStrs,ByVal Tabnamestr,ByVal CvArrstr,ByVal SqlType)
InterTbValue=False
On Error GoTo 0
On Error Resume Next
Dim def_kh_l,def_kh_r,Filarray,Valuearray,Temparraya,Temparrayb,TempSqlStr1
def_kh_l =""
def_kh_r =""
Temparraya=Split(CvArrstr,"|")
For fai = LBound(Temparraya) To UBound(Temparraya)
Temparrayb=Split(Temparraya(fai),"#")
If (fai<> UBound(Temparraya)) Then
Filarray =Filarray & "[" & Temparrayb(0) & "],"
Valuearray=Valuearray & "'" & Temparrayb(1) & "',"
Else
Filarray =Filarray & "[" & Temparrayb(0) & "]"
Valuearray=Valuearray & "'" & Temparrayb(1) & "'"
End If
Next
TempSqlStr1="INSERT INTO [" & Tabnamestr & "] (" & Filarray & ") VALUES (" & Valuearray & ")"
set fu1_Conn=server.createobject("ADODB.Connection")
fu1_Conn.open ConnStrs
fu1_Conn.Execute TempSqlStr1
fu1_Conn.Close
Set fu1_Conn=Nothing
If Err.Number = 0 Then
InterTbValue=True
End If
On Error GoTo 0
End Function
'函数名:FormatSize
'作 用:大小格式化
'参 数:size ----要格式化的大小
'****************************************************
Public Function FormatSize(dsize)
if dsize>=1073741824 then
FormatSize=Formatnumber(dsize/1073741824,2) & " GB"
elseif dsize>=1048576 then
FormatSize=Formatnumber(dsize/1048576,2) & " MB"
elseif dsize>=1024 then
FormatSize=Formatnumber(dsize/1024,2) & " KB"
else
FormatSize=dsize & " Byte"
end if
End Function
'****************************************************
系列验证----------------------------
'****************************************************
'函数名:CheckIsEmpty
'作 用:检查是否为空
'参 数:tstr ----字符串
'返回值:true不为空,false为空
'****************************************************
Public Function CheckIsEmpty(tstr)
CheckIsEmpty=false
If IsNull(tstr) or Tstr="" Then Exit Function
Dim Str,re
Str=Tstr
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
str= Replace(str, vbNewLine, "")
str = Replace(str, Chr(9), "")
str = Replace(str, " ", "")
str = Replace(str, " ", "")
re.Pattern="<img(.[^>]*)>"
str =re.Replace(Str,"94kk")
re.Pattern="<(.[^>]*)>"
Str=re.Replace(Str,"")
Set Re=Nothing
If Str<>"" Then CheckIsEmpty=true
End Function
'****************************************************
'函数名:isInteger
'作 用:整数检验
'参 数:tstr ----字符
'返回值:true是整数,false不是整数
'****************************************************
Public function isInteger(para)
on error resume Next
Dim str
Dim l,i
If isNUll(para) then
isInteger=false
exit function
End if
str=cstr(para)
If trim(str)="" then
isInteger=false
exit function
End if
l=len(str)
For i=1 to l
If mid(str,i,1)>"9" or mid(str,i,1)<"0" then
isInteger=false
exit function
End if
Next
isInteger=true
If err.number<>0 then err.clear
End Function
'****************************************************
'函数名:CheckName
'作 用:名字字符检验
'参 数:str ----字符串
'返回值:true无误,false有误
'****************************************************
Public Function CheckName(Str)
Checkname=true
Dim Rep,pass
Set Rep=New RegExp
Rep.Global=True
Rep.IgnoreCase=True
'匹配字母、数字、下划线、汉字且必须以字母或下划线或汉字开始
Rep.Pattern="^[a-zA-Z_u4e00-\u9fa5][\w\u4e00-\u9fa5]+$"
Set pass=Rep.Execute(Str)
If pass.count=0 Then CheckName=false
Set Rep=Nothing
End Function
'****************************************************
'函数名:CheckPassword
'作 用:密码检验
'参 数:str ----字符串
'返回值:true无误,false有误
'****************************************************
Public Function CheckPassword(Str)
Dim pass
CheckPassword=true
If Str <> "" Then
Dim Rep
Set Rep = New RegExp
Rep.Global = True
Rep.IgnoreCase = True
'匹配字母、数字、下划线、点号
Rep.Pattern="[a-zA-Z0-9_\.]+$"
Pass=rep.Test(Str)
Set Rep=nothing
If not Pass Then CheckPassword=false
End If
End Function
'****************************************************
'函数名:CheckEmail
'作 用:邮箱格式检测
'参 数:str ----Email地址
'返回值:true无误,false有误
'****************************************************
Public function CheckEmail(email)
CheckEmail=true
Dim Rep
Set Rep = new RegExp
rep.pattern="([\.a-zA-Z0-9_-]){2,10}@([a-zA-Z0-9_-]){2,10}(\.([a-zA-Z0-9]){2,}){1,4}$"
pass=rep.Test(email)
Set Rep=Nothing
If not pass Then CheckEmail=false
End function
安全处理----------------------------
'****************************************************
'函数名:ChkPost
'作 用:禁止站外提交表单
'返回值:true站内提交,flase站外提交
'****************************************************
Public Function ChkPost()
Dim url1,url2
chkpost=true
url1=Cstr(Request.ServerVariables("HTTP_REFERER"))
url2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(url1,8,Len(url2))<>url2 Then
chkpost=false
exit function
End If
End function
'****************************************************
'函数名:PSql
'作 用:防止SQL注入
'返回值:为空则无注入,不为空则注入并返回注入的字符
'****************************************************
public Function PSql()
Psql=""
badwords= "'防''防;防and防exec防insert防select防update防delete防count防*防%防chr防mid防master防truncate防char防declare防|"
badword=split(badwords,"防")
If Request.Form<>"" Then
For Each TF_Post In Request.Form
For i=0 To Ubound(badword)
If Instr(LCase(Request.Form(TF_Post)),badword(i))>0 Then
Psql=badword(i)
exit function
End If
Next
Next
End If
If Request.QueryString<>"" Then
For Each TF_Get In Request.QueryString
For i=0 To Ubound(badword)
If Instr(LCase(Request.QueryString(TF_Get)),badword(i))>0 Then
Psql=badword(i)
exit function
End If
Next
Next
End If
End Function
'****************************************************
'函数名:FiltrateHtmlCode
'作 用:防止生成html代码
'参 数:str ----字符串
'****************************************************
Public Function FiltrateHtmlCode(Str)
If Not isnull(str) And str<>"" then
Str=Replace(Str,Chr(9),"")
Str=replace(Str,"|","|")
Str=replace(Str,chr(39),"'")
Str=replace(Str,"<","<")
Str=replace(Str,">",">")
Str = Replace(str, CHR(13),"")
Str = Replace(str, CHR(10),"")
FiltrateHtmlCode=Str
End If
End Function
'****************************************************
'函数名:HtmlCode
'作 用:过滤Html标签
'参 数:str ----字符串
'****************************************************
Public function HtmlCode(str)
If Not isnull(str) And str<>"" then
str = replace(str, ">", ">")
str = replace(str, "<", "<")
str = Replace(str, CHR(32), " ")
str = Replace(str, CHR(9), " ")
str = Replace(str, CHR(34), """)
str = Replace(str, CHR(39), "'")
str = Replace(str, CHR(13), "")
str = Replace(str, CHR(10), "")
str = Replace(str, "script", "script")
HtmlCode = str
End If
End Function
'****************************************************
Tags:网站
前些时候被挂马页面都会被追加javascript代码 (2008-5-9 20:49:52)
Cookie使用基本方式 (2008-5-6 8:27:40)
ASP网页伪静态的实现 (2008-5-1 19:42:26)
留言本改进 GOODTEXT.ORG留言本V1.08 (2008-5-1 17:8:24)
ORG域名到期后续费需要解锁 (2008-4-19 9:27:57)
域名忘记续费,幸好过的时间不长,还没有到赎回期 (2008-4-12 19:50:8)
将网站文件打包成XML的程序代码 (2008-4-5 19:39:47)
网页滚动条CSS代码 (2008-3-31 22:14:33)
网页背景音乐实现方法 (2008-3-31 22:7:51)
GOODTEXT.ORG留言本 V 1.0 (2008-3-30 22:3:32)