ASP function 详细列表

 <%
'      　         ╭═══════════════╮
'      　            ╭══════┤  欢迎使用润满企业留言板v2.2  ├═════╮
'      　            ║            ╰═══════════════╯          ║
'      　            ║                                                        ║
'      　            ║   　　          '╭⌒╮⌒╮        　　　　      ║
'      　            ║　 　　         ╱◥██◣,,           　　　　 　  ║
'      　            ║   　　         ╬╬╬╬╬╬╬╬↓↓↓╬╬╬     　     ║
'      　            ║                                                        ║
'      　            ║                                                        ║
'      　            ║       润满  网站　Http://Www.Run-Man.Com/   　 ║
'      　            ║       润满　演示　Http://Www.Run-Man.Com/Board   　 ║
'      　            ║       作者　Kama　Welcome403@Hotmail.Com   　 ║
'      　            ║                                                        ║
'      　            ║    ╭──────────────────────╮  　║
'      　            ╰══┤   　版权所有·润满科技  　   ├══╯
'      　                  ╰──────────────────────╯
%><%

'为SQL语句格式化字符串
Function SqlStr(SqlString)
 if iSNull(SqlString) then
  SqlStr="''"
 else
  SqlStr= "'" & Replace(SqlString, "'", "''" ) & "'"
 end if
End Function

'为删除字段的'和"号
Function DelStr(delString)
 if iSNull(delString) then
  DelStr=""
 else
   DelStr=Replace(delString, "'", "＇" )  '删除'号
  ' DelStr=Replace(delString, """", "＂" )'删除"号
 end if
End Function

'''''''''''''''''''''''''''
'--------------------------
'''''''''''''''''''''''''''
'============================textarea显示用 HTMLDecode===================================
function htmlencode1(fString) 
if fString<>"" and not isnull(fString) then

    fString = replace(fString, "&gt;", ">")
    fString = replace(fString, "&lt;", "<")
    fString = Replace(fString, "", CHR(13))
    fString = Replace(fString, "</P><P>", CHR(10) & CHR(10))
    fString = Replace(fString, "<BR>", CHR(10))
  fString = Replace(fString, "&nbsp;", chr(32))
  htmlencode1=fString
else
  htmlencode1="" 
end if
end function
'===========================页面显示用htmlencode2 HTMLEncode ===========================================
function htmlencode2(fString)  
 if fString<>"" and not isnull(fString) then
 
 fString = replace(fString, ">", "&gt;")
 fString = replace(fString, "<", "&lt;")
 
 fString = Replace(fString, CHR(32), "&nbsp;")
 fString = Replace(fString, CHR(9), "&nbsp;")
 fString = Replace(fString, CHR(34), "&quot;")
 fString = Replace(fString, CHR(39), "&#39;")
 fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
 fString = Replace(fString, CHR(10), "<BR> ")
  htmlencode2=fString
else
  htmlencode2=""
end if
end function

Function FormatStr(String) '格式化text的内容
 ''on error resume next
 
 if string<>"" then
 String = Replace(String, CHR(13), "")
 String = Replace(String, CHR(10) & CHR(10), "</P><P>")
 String = Replace(String, CHR(10), "<BR>")
 String = Replace(String, CHR(32) & CHR(32), "&nbsp;&nbsp;")
 FormatStr = String
 end if
End Function

'''''''''''''''''''''''''''
'--------------------------
'''''''''''''''''''''''''''
Function UnFormatStr(String) '格式化text的内容
 ''on error resume next
 if string<>"" then
 String = Replace(String, "</P><P>",CHR(10) & CHR(10) )
 String = Replace(String, "<BR>",CHR(10) )
 String = Replace(String, "&nbsp;&nbsp;",CHR(32) & CHR(32) )
 UnFormatStr = String
 end if
End Function

'为SQL语句格式化数字字符串
Function SqlNum(SqlString)
 if trim(SqlString)="" then
  SqlNum="0"
 else
  SqlNum=SqlString
 end if
End Function

'过滤非法的词语
'''''''''BadWords 在const.asp文件中有赋值

function ChkBadWords(fString)
    bwords = split(VC_BadWords, "|")
    for i = 0 to ubound(bwords)
     'response.Write(bwords(i)&"<br>")
        fString = Replace(fString, bwords(i), string(len(bwords(i)),"*"))
    next
    fString = Replace(fString, "'","")
    ChkBadWords = fString
end function

function browser(info)'判断浏览器的程序段
    if Instr(info,"MSIE 5.5")>0 then
        browser="IE_5.5"
    elseif Instr(info,"NC 6.5.0")>0 then
     browser="NC_6.5.0"
    elseif Instr(info," 6.5.0RC1")>0 then
     browser="NC_6.5.0RC1" 
    elseif Instr(info,"NC 6.5.PB1")>0 then
     browser="NC_6.5.PB1" 
    elseif Instr(info,"MyIe 3.1")>0 then
     browser="IE_3.1"
    elseif Instr(info,"MSIE 6.0")>0 then
        browser="IE_6.0"
    elseif Instr(info,"MSIE 5.0")>0 then
        browser="IE_5.0"
    elseif Instr(info,"MSIE 5.5")>0 then
        browser="IE_5.5"
    elseif Instr(info,"MSIE 4.0")>0 then
        browser="IE_4.0"
    else
        browser="未知"
    end if
end function

function system(info)'判断操作系统的程序段
    if Instr(info,"NT 5.1")>0 then
     system=system+"Windows_XP"
    elseif Instr(info,"NT 5.2")>0 then
     system=system+"Windows_2003"
    elseif Instr(info,"Ext")>0 then
     system=system+"TelPort"
    elseif Instr(info,"webzip")>0 then
     system=system+"WebZip"
    elseif Instr(info,"flashget")>0 then
     system=system+"flashget"
    elseif Instr(info,"offline")>0 then
     system=system+"offline"   
    elseif Instr(info,"NT 5")>0 then
        system=system+"Windows_2000"
    elseif Instr(info,"NT 4")>0 then
        system=system+"Windows_NT"
    elseif Instr(info,"98")>0 then
        system=system+"Windows_98"
    elseif Instr(info,"95")>0 then
        system=system+"Windows_95"
    elseif Instr(info,"Me")>0 then
        system=system+"Windows_Me"
    else
        system=system+"未知"
    end if
end function

 '截断字符串
 function cutstr(str,bytes)
  str=alignstring(trim(str),bytes)
  cutstr=str
end function

Function AlignString( string, byVal size )
dim r,nLen,n,i,a,s_i
r = string
nLen = StrLenB( string )
' if string's width less then size ,return this string .
if ( nLen > size ) then
size = size - 2
n = 0
i = 1
' cut to index
do while ( i )
a = asc( mid( string, i, 1 ) )
if ( a < 0 ) then
if ( n + 1 = size ) then
i = i - 1
exit do
end if
n = n + 1
end if
n = n + 1
if ( n = size ) then exit do

i = i + 1
loop
'fxDebug( i )
s_i = i
a = asc( mid( string, i+1, 1 ) )
if ( IsLetter(a) ) then
do while ( 1 )
a = asc( mid( string, i, 1 ) )
if ( not IsLetter(a) ) then exit do
i = i -1
if ( i = 0 ) then
i = s_i
exit do
end if
loop
end if

r = mid( string, 1, i ) & ""
end if
AlignString = r
End Function

'截取字符串
Function StrLenB( strString )
dim intLoop,intReturn
if isNull(strString) then
StrLenB = 0
exit Function
end if
intReturn = len(strString)
for intLoop = 1 to len(strString)
if ( asc( mid( strString, intLoop, 1 ) ) < 0 ) then intReturn = intReturn + 1
next
StrLenB = intReturn
End Function

'取得权限的名字,PermissionID为在权限表中 D号码
function getPermissionName(byval PermissionID)
  if PermissionID<>"" and PermissionID<>"0"  and PermissionID<>0 then
   sqlgetPermissionName="select VC_PermissionName  from czBasicPermission where I_ID=" & PermissionID
   set thePermissionName=server.CreateObject("ADODB.Recordset")
   thePermissionName.open sqlgetPermissionName,Conn,3
  
   if not thePermissionName.eof then
    getPermissionName=thePermissionName("VC_PermissionName")
   end if
     thePermissionName.close
  end if
end function

'取得用户员的名字,userID为在操作员表中 D号码
function getUserName(byval userID)
  if userID<>"" and userID<>"0"  and userID<>0 then
   sqlgetUserName="select VC_TrueName  from czUser where I_ID=" & userID
   set theUserName=server.CreateObject("ADODB.Recordset")
   theUserName.open sqlgetUserName,Conn,3
  
   if not theUserName.eof then
    getUserName=theUserName("VC_TrueName")
   end if
     theUserName.close
  end if
end function

'获取用户ID,根据Cookies
function getUserID()
        getUserID=request.Cookies("RunMan_ID") 
end function
'取得用户员的ID,VC_AccountName为在操作员表中 D号码
function getUser_ID(byval VC_AccountName)
  if trim(VC_AccountName)<>"" and  lcase(trim(VC_AccountName))<>"guest"  then
   sqlgetUserID="select I_ID  from czUser where VC_AccountName=" & sqlstr(VC_AccountName)
   set theUserID=server.CreateObject("ADODB.Recordset")
   theUserID.open sqlgetUserID,Conn,3
  
   if not theUserID.eof then
    getUser_ID=theUserID("I_ID")
  else
  getUser_ID=0
   end if
     theUserID.close
  end if
end function

'取得用户员的登陆明,userID为在操作员表中 D号码
function getAccountName(byval userID)
  if userID<>"" and userID<>"0"  and userID<>0 then
   sqlgetAccountName="select VC_AccountName  from czUser where I_ID=" & userID
   set theAccountName=server.CreateObject("ADODB.Recordset")
   theAccountName.open sqlgetAccountName,Conn,3
  
   if not theAccountName.eof then
    getAccountName=theAccountName("VC_AccountName")
   end if
     theAccountName.close
  end if
end function
 
'获取用户登陆名，利用cookies
function get_AccountName()
        get_AccountName=request.Cookies("RunMan_AccountName")
  if trim(get_AccountName)="" then
   get_AccountName="Guest"
  end if 
end function
 

'取得组的在 表中的名字，利用组的ID
function getGroupName(byval GroupID)
if GroupID<>""  then
   sqlgetGroupName="select czgroup.VC_GroupName from [czgroup] where I_ID=" & GroupID
   set theGroupName=server.CreateObject("ADODB.Recordset")
   theGroupName.open sqlgetGroupName,Conn,3
     if not theGroupName.eof then
  getGroupName=theGroupName("VC_GroupName")
'       response.write theGroupName("VC_GroupName")
  end if
   theGroupName.close
   end if
end function

'''''''''''''''''''''''''''
'--------------------------
'''''''''''''''''''''''''''
'写入当前用户权限
function writePermission(byval userPermission)
        Session("UserPermission")=userPermission
end function

'获取用户权限
function getPermission()
 getPermission=Session("UserPermission")
end function
''''''
'判断用户权限，获取用户有权操作的ID号
'I_UserGroupID: 用户ID号 
'  ObjectID: 操作对象ID号
'    返  回: 允许操作的ID号组成的字符串
Function UserPermission(I_UserGroupID,ObjectID)
 dim SQL,rsHaveUserPermission,Result
 ' SQL = "select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=True and ((B_IFGroup=0 and I_UserGroupID="&I_UserGroupID & ") or ( B_IFGroup=True and I_UserGroupID in (select I_GroupID from czUserGroup where I_UserID=" & I_UserGroupID & ") and I_PermissionID not in (select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=0 and B_IFGroup=0 and I_UserGroupID="&I_UserGroupID&"))) GROUP BY I_PermissionID"
 
 'SQL = " select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=True and ((B_IFGroup=0 and I_UserGroupID="&I_UserGroupID & ") or (B_IFGroup=True and I_UserGroupID in (select I_GroupID from czUserGroup where I_UserID="&I_UserGroupID & "))) and I_PermissionID not in (select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=0 and B_IFGroup=True and I_UserGroupID in (select I_GroupID from czUserGroup where I_UserID="&I_UserGroupID & ")) GROUP BY I_PermissionID"
 
 sql="select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=True and ((B_IFGroup=0 and I_UserGroupID="&I_UserGroupID & ") or (B_IFGroup=True and I_UserGroupID in (select I_GroupID from czUserGroup where I_UserID="&I_UserGroupID & "))) and I_PermissionID not in (select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and B_HavePermission=0 and B_IFGroup=True and I_UserGroupID in (select I_GroupID from czUserGroup where I_UserID="&I_UserGroupID & ")) and I_PermissionID not in  (select I_PermissionID from czPermission where VC_ObjectID='" & ObjectID & "' and I_UserGroupID="&I_UserGroupID & " and B_IFGroup=0 and B_HavePermission=0) GROUP BY I_PermissionID"
  
       ' Response.Write "sql="&SQL & "<BR>"
 set rsHaveUserPermission=conn.Execute(SQL)
 Result=","
 do until rsHaveUserPermission.eof
  Result=Result & rsHaveUserPermission("I_PermissionID") & ","
  rsHaveUserPermission.movenext
 loop
 UserPermission=Result
      'response.write UserPermission
End Function

'---增加用户的操作日志
Sub addActionLog(ActionDetails)
  VC_AccountName=request.cookies("RunMan_AccountName")
  VC_IP=request.servervariables("Remote_addr")
  VC_OS=system(Request.ServerVariables("HTTP_USER_AGENT"))  
  
   if trim(VC_AccountName)="" then
     VC_AccountName="Guest"
    end if
   
  '如果不是管理员，则不添加日至
   if  instr(1,VC_IP,"192.168.")=0    then
    sqlInsertLogin="Insert into V_ActionLog (VC_AccountName,VC_IP,VC_OS,VC_Action,DT_ActionTime) values ("
    sqlInsertLogin=sqlInsertLogin & sqlstr(VC_AccountName) & ","& sqlstr(VC_IP)& ","& sqlstr(VC_OS) & ","&sqlstr(ActionDetails)&","& sqlstr(now()) & ")"
    'response.write sqlInsertLogin
     conn.execute (sqlInsertLogin)

     end if
end sub
 
 
 '---增加用户的登陆量
 Sub addLoginNumber()
   
   sqlupdate="update N_Count set  N_AccessNumber=N_AccessNumber+1"
   conn.execute (sqlupdate)
 
 end sub

'---增加页面访问量

sqlupdate="update N_Count set N_PageView=N_PageView+1"
conn.execute (sqlupdate)

'response.End()
%>
<script language="JavaScript">

function ChrToUpperCase(obj,value)
{
obj.value=value.toUpperCase( );

}
function ChrToLowerCase(obj,value)
{
obj.value=value.toLowerCase( );

}
//检查三否为数字
function checknum(tempvalue,obj){
if (tempvalue.length!=0){
  if (!(/^[/d]+/.?/d*$/.test(tempvalue)) ){
    alert("您的输入有误,请输入数字！");
    obj.value="";
    obj.focus();
    return false;
  }
}
return true;
}

  //再来一个检查email的
  function chk_email(email,obj)
{ 
　var pattern =  /^/w+((-/w+)|(/./w+))*/@[A-Za-z0-9]+((/.|-)[A-Za-z0-9]+)*/.[A-Za-z0-9]+$/;
　flag = pattern.test(email);
　if(email.length!=0 && !flag)
　{
　alert("email格式不正确!");
 obj.focus();
　return false;
　}
return (true);
}

  //打开一个新的窗口
 
  function openawindow(url,id,width,height)
  {
  window.open (url, '', 'width='+width+',height='+height+', toolbar=no, menubar=no, scrollbars=yes,resizable=auto,location=no, status=no')
  }
</script>
<script language="VBScript">
//判断是否是合法的日期格式,考虑闰年
function checkri(nian,month,ri)
    select case month
        case 1,3,5,7,8,10,12
            lastday=31
     case 4,6,9,11
      lastday=30
     case 2
       if( nian mod 4=0 and nian mod 100<>0 or nian mod 400=0 ) then
          lastday=29
     else
          lastday=28
       end if
     end select  
  if cint(ri)>lastday then
       checkri=0  //如果非法的日期
    else
     checkri=1
    end if
      //使用方法 flag=checkri( year , month , day )
end function
</script>

  <script language="JavaScript" type="text/JavaScript">
  //转到详细的页面
  //*URL为页面的相对地址
  //*page为第几页
  //end
function goURL(URL,page)
{
URL=URL + "?page="+page;
//alert(URL);
 window.location=URL;
}
</script>