002

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:网站  

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。