自己在最老版本基础上改的easyasp

[GoogleCodeExporter]

今天进来看了下，这里很火，老大改进也不少，我将我的一��
�也贴出来，要不都放糜了！

clscheck.asp:

<%
Function checkpageid(n)
    Dim pageid
    if not isnumeric(n) then                             
        pageid=1                              
    elseif n="" then                             
        pageid=1                             
    elseif n<1 then                             
        pageid=1                             
    else                             
        pageid=clng
(n)                                                       
    end if 
    checkpageid = pageid
End Function
Function checknumid(n)
    Dim checkvalid
    if not isnumeric(n) then  
    checkvalid =false
    ElseIf Len(n) > 5 Then
    checkvalid =false
    ElseIf IsNull(sID) OR Trim(sID) = "" Then 
    checkvalid = false
    Else
    checkvalid = True
    End If
    cheknumid = checkvalid  
End Function

Function checkstr(iniword,initype)
    Dim tmplen,fuckword,sqlword,myvar
    myvar=LCase(iniword)
    myvar=Trim(myvar)
    fuckword="<|>|'|=|-|/|\|*|@|#|$|&|%|^|(|)|+|日|干|爸|妈|操|婊子
|shit|fuck|鸡吧|王八|发票|娱乐|com|net|cn|name|www|http|草|母|姐|你�
��
|ma|jie|ri|gan|bi|cao|update|and|set|or|select|delete"
    sqlword="update|and|set|or|select|delete|insert|exec|add|fetch|exis
ts|execute|alter|group|having|char|join|with|grant|from|where|as|=|'|>|<"
    if IsNull(myvar) then
        checkstr = False
    End if      
    Select  Case initype
            Case "num_id"    
                tmplen=Len(myvar)
                If tmplen > 6   Then 
                    checkstr = False
                End If 
                if Not IsNumeric(myvar) Then
                    checkstr = False

                End If
            Case "num"  
                checkstr = IsNumeric(myvar)

            Case "txt_id"   
                MyArray = Split(sqlword, "|", -1, 1)
                For i = 0 To  ubound(MyArray)
                    if Instr(1, myvar, MyArray(i), 1) 
> 0 then
                    checkstr=false
                    Exit For

                    end if
                Next
            Case "fuck_txt" 
                MyArray = Split(fuckword, "|", -1, 1)
                For i = 0 To  ubound(MyArray)
                    if Instr(1, myvar, MyArray(i), 1) 
> 0 then
                    checkstr=false
                    Exit For

                    end if
                Next
            Case "nohtml_txt"

            Case "page_id"
                if not isnumeric(myvar) 
then                             
                checkstr=1                              
                elseif myvar="" 
then                             
                checkstr=1                             
                elseif myvar<1 
then                             
                checkstr=1                             
                else                             
                checkstr=clng
(myvar)                                                       
                end if 

            Case "zhcn_txt"
                Set RegExpObj=new RegExp 
                RegExpObj.Pattern="^[A-Za-z0-9]+$" 
                ReGCheck=RegExpObj.test(myvar) 
                Set RegExpObj=nothing 
                if ReGCheck then 
                checkstr =False

                else
                checkstr =True

                end if 
            Case guest_txt
                if Len(myvar) > 220 or Len(myvar) < 2 then
                checkstr = false
                exit function       
                end if
            Case Else       
    End Select
End function

' ********************************************
' 检测数据库中某字段是否存在某值，单值检测
' ********************************************
'Function existme(mytable,myfiled,myfiledvalue)
'Dim sql,rs,existtmp
'existtmp = false
'If IsNumeric(myfiledvalue) Then 
'sql="Select ["&myfiled&"] from ["&mytable&"] where ["&myfiled&"] 
="&myfiledvalue&""
'Else 
'sql="Select ["&myfiled&"] from ["&mytable&"] where ["&myfiled&"] 
='"&myfiledvalue&"'"
'End If 
'OpenConn()  
'Dim db : Set db = New DbCtrl
'Set rs = db.GetRecordBySQL(sql)
'If not rs.bof and not rs.eof  then
'   If rs.Fields(0).Value = myfiledvalue Then 
'   existtmp = true
'   Else
'   existtmp = false
'   End If
'Else 
'existtmp = False
'End If
'existme = existtmp 
'End Function

' ********************************************
' 检测数据库中某字段是否存在某值，多值检测
' ********************************************
Function existme(mytable,myfiled,myfiledvalue)
'usage:existme("[mytable]","[colone],[coltow]","valuone,valutow")
Dim sql,rs,existtmp,arrtempf,arrtempv,numf,numv,tmpmyfiled,tmpmyfiledvalue
existtmp = False

If Instr(myfiled,",")>0 Then
    arrtempf = Split(myfiled,",")
    numf = Ubound(arrtempf)

    tmpmyfiled = arrtempf(0)
Else 
    numf = 0
    tmpmyfiled = myfiled
End if

If Instr(myfiledvalue,",")>0 Then
    arrtempv = Split(myfiledvalue,",")
    numv = Ubound(arrtempv)
    tmpmyfiledvalue = arrtempv(0)
Else 
    numv = 0
    tmpmyfiledvalue = myfiledvalue
End If

If numf <> numv Then 
existme = False
Exit function
End If 

If IsNumeric(myfiledvalue) Then 
'sql="Select ["&myfiled&"] from ["&mytable&"] where ["&tmpmyfiled&"] 
="&myfiledvalue&""
sql="Select "&myfiled&" from "&mytable&" where "&tmpmyfiled&" 
='"&tmpmyfiledvalue&"'"
Else 
sql="Select "&myfiled&" from "&mytable&" where "&tmpmyfiled&" 
='"&tmpmyfiledvalue&"'"
End If 
OpenConn()  
Dim db : Set db = New DbCtrl
Set rs = db.GetRecordBySQL(sql)
    If not rs.bof and not rs.eof  Then
        If numf > 0 then            
            For i=0 To numf
            If rs.Fields(i).Value <> arrtempv(i) Then 
            existtmp = False
            Exit for
            else 
            existtmp = true
            End If
            Next
        Else
            If rs.Fields(0).Value = myfiledvalue Then 
            existtmp = true
            Else
            existtmp = false
            End If
        End if
    Else 
    existtmp = False
    End If
existme = existtmp 
End Function

'response.write existme("[Category]","[Category_Name],[Category_Intro]","我
的爱人,有关桃子的事情")

'response.write existme("[Category]","[Category_Name]","我的爱人")

' ********************************************
' 以下为常用函数
' ********************************************
' ============================================
' 错误返回处理
' ============================================
Sub GoError(str)
    Call DBConnEnd()
    Response.Write "<script language=javascript>alert('" & str & "\n\n
系统将自动返回前一页面...');history.back();</script>"
    Response.End
End Sub

' ============================================
' 进行操作判断，是否进一步操作
' strAlert 提示语言 url1 确认返回的地址 url2 取消返回的地址
' ============================================
Function Confirm(strAlert,url1,url2)
    Response.Write("<Script Language='Javascript'>")
    Response.Write("if(confirm('"& strAlert &"'))")
    Response.Write("{")
    Response.Write("location.href='" & url1 & "';")
    Response.Write("}")
    Response.Write("else")
    Response.Write("{")
    Response.Write("location.href='" & url2 & "';")
    Response.Write("}")
    Response.Write("</Script>")
End Function

' ============================================
' 进行操作判断，是否进一步操作
' strAlert 提示语言 Num 确认返回的地址
' ============================================
Function OKToWhere(strAlert,Num)
    Response.Write("<Script Language='Javascript'>")
    Response.Write("alert('" & strAlert & "');")
    Response.Write("history.go(" & Num & ");")
    Response.Write("</Script>")
    Response.End
End Function

' ============================================
' 操作提示信息
' str 提示的详细内容
' ============================================
Function AlertMsg(str)
    Response.Write("<Script Language='Javascript'>")
    Response.Write("alert('" & str & "');")
    Response.Write("</Script>")
End Function

' ============================================
' 判断是否是数字，否则用默认值替换
' iCheck 要替换的变量,iDefault 默认值
' ============================================
Function GetSafeInt(iCheck,iDefault) 
    If Trim(iCheck)="" Then
        GetSafeInt = iDefault
        Exit Function
    End If

    If IsNumeric(iCheck)=false Then
        GetSafeInt = iDefault
        Exit Function
    End If

    GetSafeInt = iCheck
End Function

' ============================================
' 得到安全字符串,在查询中或有必要强行替换的表单中使用
' str 要替换的字符串
' ============================================
Function GetSafeStr(str)
'   GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr
(34), ""), ";", "")
    GetSafeStr = Replace(Replace(Replace(Replace(Replace
(str,"'","‘"),"""","“"),"&",""),"<","&lt;"),">","&gt;")
End Function

' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
    Dim sTemp
    sTemp = str
    outHTML = ""
    If IsNull(sTemp) = True Then
        Exit Function
    End If
    sTemp = Replace(sTemp, "&", "&amp;")
    sTemp = Replace(sTemp, "<", "&lt;")
    sTemp = Replace(sTemp, ">", "&gt;")
    sTemp = Replace(sTemp, Chr(34), "&quot;")
    sTemp = Replace(sTemp, Chr(10), "<br>")
    outHTML = sTemp
End Function
' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
    Dim sTemp
    sTemp = str
    inHTML = ""
    If IsNull(sTemp) = True Then
        Exit Function
    End If
    sTemp = Replace(sTemp, "&", "&amp;")
    sTemp = Replace(sTemp, "<", "&lt;")
    sTemp = Replace(sTemp, ">", "&gt;")
    sTemp = Replace(sTemp, Chr(34), "&quot;")
    inHTML = sTemp
End Function

Sub checklogin()
If session("c_username")=""  Then 
Response.Redirect "login.asp"
response.end
End If
End Sub

Sub checkadduser()
If session("c_username") <> ""  And   session("c_level") < 3 Then 
Response.Redirect "add.asp"
response.end
End If
End Sub
Sub checkadduser()
If   session("c_level") < 3 Then 
Response.Redirect "login.asp"
response.end
End If
End sub
%>

Original issue reported on code.google.com by jioudaot...@gmail.com on 6 Nov 2009 at 2:24

[GoogleCodeExporter]

clstemple.asp:
<%
Class Template
Private FSO,re
public last_error,halt_on_error,debug
Private m_root,unKnowns,m_nfile
Private varkeys,varvals

Private Sub class_Initialize
       Set FSO=CreateObject("Scripting.FileSystemObject")
       Set re = new regexp : re.IgnoreCase = true : re.Global = true
       Set m_nfile=CreateObject("Scripting.Dictionary")
       Set varkeys=CreateObject("Scripting.Dictionary")
       Set varvals=CreateObject("Scripting.Dictionary")
       m_root="templates/"
       unknowns="keep"
       debug="false"
       halt_on_error="yes"
End Sub

Public Sub Set_Root(Byval root)
       If FSO.FolderExists(Server.MapPath(root)) Then
              m_root=replace(root,"\","/")
              If m_root<>"" and not Right(m_root,1)="/" Then
                     m_root=m_root & "/"
                     If debug Then response.write "Set_Root:Root 
is "&m_root&".<br>"
              Else
                     Call halt("模版目录名有错.")
                     Exit Sub
              End If
       Else
              Call halt("找不到模版目录.")
              Exit Sub
       End If
End Sub

Public Property Get Root
       Root=m_root
End Property

Public Sub set_unknowns(ByVal A_strUnknowns)
      Unknowns = A_strUnknowns
End Sub

Public Sub set_file(handle,str_filename)
Dim str_tmp
If NOT IsArray(handle) Then
       If str_filename="" Then 
              Call halt("set_file: For handle"& handle &"filename is 
empty.<br>")
              Exit Sub
       End If
       str_tmp=filename(str_filename)
       If debug Then response.write "set_file:set " & handle & "=" & 
Str_tmp & ".<br>"
       m_nfile.add handle,str_tmp
Else
       Call setFiles(handle)
End If
End Sub

Public Sub setfiles(s_handle)
Dim num,i
       If IsArray(s_handle) Then
              num=UBOUND(s_handle)
              If((num+1) mod 2)<>0 Then
                     Call halt("set_file:For handle's array have some 
error")
                     Exit Sub
              Else
                     For i=0 to num step 2
                            Call Set_file(s_handle(i),s_handle(i+1))
                     Next
              End If
       End If
End Sub

Public Function get_undefined(handle)
Dim Str,i,result
If Not LoadFile(handle) Then
       Call halt("get_undefined: unable to load "& handle&".<br>")
       get_undefined=false
       Exit Function
End If
       Str=get_var(handle)
       re.Pattern = "({)([^ \t\r\n}]+)}"
       Set matches=re.execute(Str)
       i=0
       For each match in matches
              If not varvals.exists(match.submatches(1)) Then
                     result(i)=match.submatches(1)
                     i=i+1
              End If
       Next
       If IsArray(result) Then
              get_undefined=result
       Else
              get_undefined=false
       End If
End Function

Public Sub set_block(parent,handle,str_Name)
Dim Str,matches,matche,str_matche
If Not LoadFile(parent) Then
       Call halt("subst: unable to load"& parent &".")
       Exit Sub
End If
If str_name="" Then str_name=handle
Str=Get_var(parent)
re.Pattern = "<!" & "--\s+BEGIN\s+(" & handle & ")\s+-->([\s\S.]*)<!" & "--
\s+END\s+" & handle & "\s+-->"
Set Matches = re.Execute(Str)
For each matche In matches
       'response.write matche.value &"dd"
       str_matche=matche.submatches(1)
       Str=re.replace(Str,"{" & str_name & "}")
       Call Set_Var(handle,str_Matche)
       Call Set_Var(parent,Str)
Next
End Sub

Public Sub Set_var(byval str_varname,byval value)
Dim Str
If Not IsArray(str_varname) Then
       If str_varname<>"" Then
              If debug Then response.write "scalar: set "& str_varname &" 
to "& value &"<br>"&vbCRLF
       End If
              Str=varname(str_varname)
              If varkeys.Exists(str_varname) Then
                     varkeys.remove(str_varname)
                     varkeys.add str_varname,"/"& Str &"/"
              Else
                     varkeys.add str_varname,"/"& Str &"/"
              End If
              If debug Then 
response.write "set_var:varkeys.add "&str_varname&","&str&".<br>"
              If varvals.Exists(str_varname) Then
                     varvals.remove(str_varname)
                     varvals.add str_varname,value
              Else
                     varvals.add str_varname,value
              End If
Else
       Call Setvars(str_varname)
End If
End Sub

Public Sub SetVars(ByVal A_varname)
  Dim i, num
   If IsArray(A_varname) Then
    num = Ubound(A_varname)
    if ((num +1) mod 2) <> 0 Then
     Call halt("SetVars: For varname array's element not gemination.<br>")
     Exit Sub
    Else
     For i = 0 To num Step 2
      Call Set_Var(A_varname(i), A_varname(i+1))
     Next
    End If
   Else
    Call Set_Var(A_varname, "")
   End If
End Sub

Public Function subst(handle)
Dim Str
       If not LoadFile(handle) Then
              Call halt("subst:unableto load "& handle &".<br>")
              subst=false
       End If
       Str=get_var(handle)
       re.Pattern="({)([^\t\r\n}]+)}"
       Set matches=re.execute(Str)
       For each match in matches
              If varvals.exists(match.submatches(1)) Then
                     re.pattern=match.value
                     Str=re.replace(Str,varvals.item
(match.submatches(1)))
              End If
       Next
       subst=Str
End Function 
Public Sub psubst(handle)
       response.write  subst(handle)
End Sub

Public Function myparse(target,handle,Append)
Dim Str 
       If NOT IsArray(handle) Then
              Str=subst(handle)
              If(Append) Then
                     Call set_var(target,Get_var(target)&Str)
              Else
                     Call set_var(target,Str)
              End If
       Else
              For i=0 to UBound(handle)
                     Str=subst(handle(i))
                     If(Append) Then
                            Call set_var(target,Get_var(target)&Str)
                     Else
                            Call set_var(target,Str)
                     End If
              Next 
       End If     
       myparse=Str
End Function
Public Function pparse(target,handle,Append)
       response.write myparse(target,handle,Append)
End Function

Public Function p(varname)
       response.write finish(get_var(varname))
End Function

Public Function vGet(varname)
       vGet=finish(get_var(varname))
End Function

Public Function finish(Str)
Dim str_trmp
       Select Case unknowns
       Case "keep"
              str_tmp=Str
       Case "remove"
              re.Pattern = "({)([^ \t\r\n}]+)}"
              str_tmp=re.replace(Str,"")
       Case "comment"
              re.Pattern = "({)([^ \t\r\n}]+)}"
              Set mathces=re.execute(Str)
              For each match in mathces
                     str_tmp=Replace(Str, "<!"&"-- Template variable " & 
Match.SubMatches(1) &" undefined -->")
              Next
       End Select
       finish=str_tmp

End Function 

Private Function varname(Str)
       varname="{" & Str & "}"
End Function

Public Function get_vars()
       Set get_vars=varvals
End Function

Public Function Get_Var(varname)
Dim tmp,Count,Str
       If NOT IsArray(varname) Then 
              If varvals.Exists(varname) Then
                     get_var=varvals.Item(varname)
              End If
       Else
              Set tmp=CreateObject("scripting.Dictionary")
              Count=UBound(varname)
              For i=0 to Count
                     If varvals.Exists(varname(i)) Then
                            Str=varvals.Item(varname(i))
                            tmp.add varname(i),Str
                            If debug Then response.write "Get_var: set "& 
varname(i) &" to "& Str &"<br>"&vbCRLF
                     End If
              Next       
              Set getvar=tmp
       End If
End Function

Private Function LoadFile(handle)
Dim Str_filename,str_file,Str
       If varkeys.Exists(handle) and varkeys.Item(handle)<>"" Then 
              LoadFile=true
              Exit Function
       End If
       If Not m_nfile.Exists(handle) then
              call halt("loadfile:"& handle &" is not a valid handle.<br>")
              LoadFile=False
              Exit Function
       End If
       str_filename=m_nfile.Item(handle)
       str_filename=Server.Mappath(str_filename)
       If debug Then response.write str_filename &"<br>"
       If Not FSO.FileExists(str_filename) Then
              Call halt("loadfile:"& str_filename &" is not a valid 
file.<br>")
              LoadFile=false
              Exit Function
       End If
              Set str_file=FSO.OpenTextFile(Str_filename)
              Str=str_file.readall()
              str_file.close
              Set str_file=nothing
              If Str="" Then
                     Call halt("loadfile: While loading"& handle &","& 
str_filename &"does not exist or is empty.<br>")
                     LoadFile=false
                     Exit Function
              End If
              Call set_var(handle,Str)
              LoadFile=true
End Function

Private Function FileName(str_filename)
       FileName=m_root & str_filename
End Function 

Public Sub Halt(msg)
       last_error=msg
       If halt_on_error<>"no" Then Call haltmsg(msg)
       If halt_on_error="yes" Then 
              response.write "Halted."
              response.end
       End If
End Sub

Public Sub haltmsg(msg)
       Response.Write "Template Error:" & msg & "<br>"
End Sub
Public Sub viewcache()
response.write "varkeys:<br>"
a=varkeys.keys
       For d=0 to varkeys.count-1
              response.write "key:"&a(d) &" value:"& varkeys.item(a(d))
&"<br>"
       Next
response.write "varvals:<br>"
a=varvals.keys
       For d=0 to varvals.count-1
              response.write "key:"&a(d) &" value:"& varvals.item(a(d))
&"<br>"
       Next
End Sub         
Private Sub class_Terminate
  Set FSO = Nothing
  Set m_nfile=nothing
  Set VarKeys = Nothing
  Set VarVals = Nothing
  Set re = Nothing
End Sub         

'使用方法如：Call Navagationlist
("Category","Category_ID,Category_Name","Category_ID ASC","yubo")
'必须提前调用yuclsdbctrl.asp
Public Function Navagationlist1(ByVal TableName,ByVal FieldsList,ByVal 
OrderField,ByVal fname)
Dim sql
    Call OpenConn()        '打开数据库连接
Dim db : Set db = New DbCtrl  '建立对象
    sql = db.wGetRecord(TableName,FieldsList,"",OrderField,"-1")
Set rs = db.GetRecordBySQL(sql)
    temparray=rs.getrows
    response.write "<SELECT  SIZE=""1""  name="&fname&" width=""200"">"
    response.write "<OPTION>选择类别</OPTION>"
For i = 0 To  ubound(temparray,2)
    response.write "<OPTION VALUE= "&temparray(0,i)&" > "&temparray(1,i)
&"</OPTION>"
If  i > rs.recordcount  Then 
Exit For
End if
Next
   Set rs = nothing
   call Closemyobj(db)
   Call closeconn()
End Function
'使用方法如：Call Navagationlist
("Category","Category_ID,Category_Name","Category_ID ASC","yubo")
'必须提前调用yuclsdbctrl.asp
Public Function Navagationlist(ByVal TableName,ByVal FieldsList,ByVal 
OrderField,ByVal fname)
Dim rs,sql,str
    OpenConn()        '打开数据库连接
Dim db : Set db = New DbCtrl  '建立对象
    sql = db.wGetRecord(TableName,FieldsList,"",OrderField,"-1")
Set rs = db.GetRecordBySQL(sql)
    temparray=rs.getrows

  str= "<SELECT  SIZE=""1""  name="&fname&" width=""200"">"
  str= str &"<OPTION>选择类别</OPTION>"
For i = 0 To  ubound(temparray,2)
  str= str &"<OPTION VALUE= "&temparray(0,i)&" > "&temparray(1,i)
&"</OPTION>"
If  i > rs.recordcount  Then 
Exit For
End if
Next
    Navagationlist=str
    Set rs = nothing
    call Closemyobj(db)
    Call closeconn()
End function
End Class
%>

Original comment by jioudaot...@gmail.com on 6 Nov 2009 at 2:24

[GoogleCodeExporter]

clsdbctrl.asp内容如附件

Original comment by jioudaot...@gmail.com on 6 Nov 2009 at 2:29

Attachments:

• yuclsDbCtrl.asp

[GoogleCodeExporter]

@jioudaotian
你不是说要放个例子出来么~

Original comment by cxxk...@gmail.com on 21 Nov 2009 at 6:41